add format-datums
This commit is contained in:
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…
Reference in New Issue
Block a user