update func expander

pull/2/head
Matthew Butterick 8 years ago
parent 90ec2a1244
commit e2df4fee70

@ -5,22 +5,24 @@
PARSE-TREE)) PARSE-TREE))
(provide (rename-out [bf-module-begin #%module-begin])) (provide (rename-out [bf-module-begin #%module-begin]))
(define (fold-funcs apl bf-funcs)
(for/fold ([current-apl apl])
([bf-func (in-list bf-funcs)])
(apply bf-func current-apl)))
(define-macro (bf-program OP-OR-LOOP-ARG ...) (define-macro (bf-program OP-OR-LOOP-ARG ...)
#'(void (fold-args (list (make-vector 30000 0) 0) #'(begin
OP-OR-LOOP-ARG ...))) (define first-apl (list (make-vector 30000 0) 0))
(void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...)))))
(provide bf-program) (provide bf-program)
(define (fold-args apl . bf-args)
(for/fold ([current-apl apl])
([bf-arg (in-list bf-args)])
(apply bf-arg current-apl)))
(define-macro (loop "[" OP-OR-LOOP-ARG ... "]") (define-macro (loop "[" OP-OR-LOOP-ARG ... "]")
#'(lambda (arr ptr) #'(lambda (arr ptr)
(for/fold ([current-apl (list arr ptr)]) (for/fold ([current-apl (list arr ptr)])
([i (in-naturals)] ([i (in-naturals)]
#:break (zero? (apply current-byte apl))) #:break (zero? (apply current-byte
(fold-args current-apl OP-OR-LOOP-ARG ...)))) current-apl)))
(fold-funcs current-apl (list OP-OR-LOOP-ARG ...)))))
(provide loop) (provide loop)
(define-macro-cases op (define-macro-cases op

Loading…
Cancel
Save