>>10
I've extended to vectors now
(define-module (do-stuff)
#:use-module (macro-help)
#:use-module (srfi srfi-4 gnu)
#:export-syntax (dolist dotimes do-sequence do-string do-vector))
(define-syntax dolist
(syntax-rules ()
((dolist (var list) body ...)
(dolist (var list (values)) body ...))
((dolist (var list value) body ...)
(begin (for-each (λ (var) body ...) list) value))))
(define-macro (dotimes of . body)
(case (length of)
((2) `(dotimes (,@of (values)) ,@body))
((3) (let ((expr (uniqsym)))
`(let ((,expr ,(cadr of)))
(do ((,(car of) 0 (1+ ,(car of))))
((= ,(car of) ,expr) ,(caddr of)) ,@body))))))
(define-macro (do-sequence for-each-index seq-ref of . body)
(case (length of)
((2) (if (list? (car of))
`(do-sequence ,for-each-index ,seq-ref (,@of (values)) ,@body)
`(do-sequence ,for-each-index ,seq-ref
((,(car of) ,(symbolicate (car of) '-index))
,(cadr of) (values)) ,@body)))
((3) (if (list? (car of))
`(reverse-args begin ,(caddr of)
(reverse-args ,for-each-index ,(cadr of)
(lambda (,(cadar of))
(let ((,(caar of) (,seq-ref ,(cadr of) ,(cadar of)))) ,@body))))
`(do-sequence ,for-each-index ,seq-ref
((,(car of) ,(symbolicate (car of) '-index))
,(cadr of) ,(caddr of)) ,@body)))))
(define-macro (do-string of . body)
`(do-sequence string-for-each-index string-ref ,of ,@body))
; im not proud of this
(define-public (which-vector-length v)
(cond ((vector? v) vector-length)
((bitvector? v) bitvector-length)
((u8vector? v) u8vector-length)
((s8vector? v) s8vector-length)
((u16vector? v) u16vector-length)
((s16vector? v) s16vector-length)
((u32vector? v) u32vector-length)
((s32vector? v) s32vector-length)
((u64vector? v) u64vector-length)
((s64vector? v) s64vector-length)
((f32vector? v) f32vector-length)
((f64vector? v) f64vector-length)
((c32vector? v) c32vector-length)
((c64vector? v) c64vector-length)))
(define-public (which-vector-ref v)
(cond ((vector? v) vector-ref)
((bitvector? v) bitvector-ref)
((u8vector? v) u8vector-ref)
((s8vector? v) s8vector-ref)
((u16vector? v) u16vector-ref)
((s16vector? v) s16vector-ref)
((u32vector? v) u32vector-ref)
((s32vector? v) s32vector-ref)
((u64vector? v) u64vector-ref)
((s64vector? v) s64vector-ref)
((f32vector? v) f32vector-ref)
((f64vector? v) f64vector-ref)
((c32vector? v) c32vector-ref)
((c64vector? v) c64vector-ref)))
(define-public (vector-for-each-index proc vector)
(dotimes (i ((which-vector-length vector) vector)) (proc i)))
(define-macro (do-vector of . body)
(let ((cwrs (uniqsym)))
`(let ((,cwrs (λ (v i) ((which-vector-ref v) v i))))
(do-sequence vector-for-each-index ,cwrs ,of ,@body))))