add `format-datums`

pull/2/head
Matthew Butterick 8 years ago
parent 37951c7198
commit 99ebc4f804

@ -26,6 +26,9 @@
(syntax->datum arg) (syntax->datum arg)
arg)) args)))) arg)) args))))
(define (format-datums datum-template args)
(map (λ(arg) (format-datum datum-template arg)) args))
(module+ test (module+ test
(require rackunit syntax/datum) (require rackunit syntax/datum)
(check-equal? (string->datum "foo") 'foo) (check-equal? (string->datum "foo") 'foo)
@ -36,4 +39,5 @@
(check-equal? (format-datum '(~a-bar-~a) #'foo #'zam) '(foo-bar-zam)) (check-equal? (format-datum '(~a-bar-~a) #'foo #'zam) '(foo-bar-zam))
(check-equal? (format-datum (datum (~a-bar-~a)) "foo" "zam") '(foo-bar-zam)) (check-equal? (format-datum (datum (~a-bar-~a)) "foo" "zam") '(foo-bar-zam))
(check-equal? (format-datum '~a "foo") 'foo) (check-equal? (format-datum '~a "foo") 'foo)
(check-equal? (format-datum (datum ~a) "foo") 'foo)) (check-equal? (format-datum (datum ~a) "foo") 'foo)
(check-equal? (format-datums '(put ~a) '("foo" "zam")) '((put foo) (put zam))))

@ -1,15 +1,16 @@
#lang br/quicklang #lang br/quicklang
(define (read-syntax src-path in-port) (define (read-syntax src-path in-port)
(define arg-datums (port->list read in-port)) (define args (port->list read in-port))
(define arg-datums (format-datums '(handle ~a) args))
(define module-datum `(module mod-name br/demo/stacker (define module-datum `(module mod-name br/demo/stacker
,@arg-datums)) ,@arg-datums))
(datum->syntax #f module-datum)) (datum->syntax #f module-datum))
(provide read-syntax) (provide read-syntax)
(define-macro (stacker-module-begin ARG-STX ...) (define-macro (stacker-module-begin ARG-DATUM-STX ...)
#'(#%module-begin #'(#%module-begin
(put ARG-STX) ... ARG-DATUM-STX ...
(display (pop-stack!)))) (display (pop-stack!))))
(provide (rename-out [stacker-module-begin #%module-begin])) (provide (rename-out [stacker-module-begin #%module-begin]))
@ -23,14 +24,14 @@
(define (push-stack! item) (define (push-stack! item)
(set! stack (cons item stack))) (set! stack (cons item stack)))
(define (put arg) (define (handle arg)
(cond (cond
[(number? arg) (push-stack! arg)] [(number? arg) (push-stack! arg)]
[else [else
(define op-result (arg (pop-stack!) (pop-stack!))) (define op-result (arg (pop-stack!) (pop-stack!)))
(push-stack! op-result)])) (push-stack! op-result)]))
(provide + *) (provide handle + *)
(module+ test (module+ test
(require rackunit) (require rackunit)

Loading…
Cancel
Save