Hi,
I'm trying to construct a function that will walk all paths on a 2- or
3-dimensional rectangular grid and calculate their squared lengths, using macros
to account for the differences in dimension.
Unfortunately I do not understand syntax-case very well yet, so I'm unable to
solve the errors that are reported. If someone could take a look at my code that
would be much appreciated. Currently it errors with:
$ gsi -:s stripped-randomwalk -e "(main 10)"
*** ERROR IN %%rebuild-macro-output1427, "/usr/lib64/syntax-case.scm"@9057.7 --
encountered raw symbol + in output of macro (step)
Thanks in advance,
Marijn
--
If you cannot read my mind, then listen to what I say.
Marijn Schouten (hkBst), Gentoo Lisp project, Gentoo ML
http://www.gentoo.org/proj/en/lisp/, #gentoo-{lisp,ml} on FreeNode
; $ gsi -:s stripped-randomwalk -e "(main 10)"
(define-syntax DIM
(syntax-rules ()
((DIM) 2)))
; ((DIM) 3)))
;;; (reduce-map unit reducer mapper list)
;;; (reduce-map u r m '()) |-> u
;;; (reduce-map u r m l) |-> (reduce u r (map m l))
(define-syntax macro-reduce-map
(syntax-rules ()
((_ u r m) u)
((_ u r m a b ...)
(r (m a)
(macro-reduce-map u r m b ...)))))
(define-syntax L2-norm
(syntax-rules ()
((_ a ...) (macro-reduce-map 0 + (lambda (e) (* e e)) a ...))))
(define (main depth)
(pp (/ (walk depth) (expt (* 2 (DIM)) depth))))
(define (walk depth)
(let-syntax
((step
(lambda (stx)
(syntax-case stx ()
((k)
(letrec ((vector-map (lambda (f v)
(let* ((l (vector-length v))
(ret (make-vector l)))
(let loop ((i 0))
(cond ((= i l) ret)
(else (vector-set! ret i (f (vector-ref v i) i))
(loop (+ i 1))))))))
(make-next-coords (lambda (names pos inc)
(if (= pos 0)
(cons `(+ ,(car names) ,inc) (cdr names))
(cons (car names) (make-next-coords (cdr names) (- pos 1) inc))))))
(let* ((coords (generate-temporaries (vector->list (make-vector (DIM)))))
(next (vector->list (let ((next-v (make-vector (* 2 (DIM)))))
(vector-map (lambda (e i) (make-next-coords coords (modulo i (DIM)) (if (< i (DIM)) +1 -1))) next-v)))) )
#`(let %step #,(datum->syntax-object #'k (cons '(d 0) (map (lambda (c) (list c 0)) coords)))
(cond ((< d depth)
(let* ((d+1 (fx+ d 1))
(d-next (map (lambda (l) (cons d+1 l)) #,next)) )
(macro-reduce-map 0 + %step d-next)))
(else (L2-norm coords)) )) ) ))))))
(step)))
;; (define (walk-f depth)
;; (let step ((d 0) (x 0) (y 0) #;(z 0))
;; (cond ((< d depth)
;; (let ((d+1 (+ d 1)))
;; (+
;; (step d+1 (+ x 1) y)
;; (+
;; (step d+1 (- x 1) y)
;; (+ (step d+1 x (+ y 1))
;; (step d+1 x (- y 1))) ))))
;; (else
;; (L2-norm x y)))))