pull/2/head
Matthew Butterick 10 years ago
parent 25fbd16843
commit d9d66faa1c

@ -1,44 +1,27 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/syntax)
(provide macro-map macro-for-each)
(provide define->macro)
(define-syntax-rule (make-mappy-macro mappy-macro-name joining-proc ending-value)
(define-syntax mappy-macro-name
(syntax-id-rules ()
;; convert quote form into list form
[(_ macro-name (quote (items (... ...))))
(mappy-macro-name macro-name (list items (... ...)))]
;; catch this case first, because it would also match the next one
[(_ macro-name (list item0))
(joining-proc
(macro-name item0) ending-value)]
[(_ macro-name (list item0 items (... ...)))
(joining-proc
(macro-name item0)
(mappy-macro-name macro-name (list items (... ...))))])))
(define-syntax define->macro
(syntax-rules ()
[(_ (proc-name arg ... . rest-arg) proc-expr ...) (define->macro proc-name (λ(arg ... . rest-arg) proc-expr ...))]
[(_ proc-name proc) (define-syntax proc-name
(syntax-id-rules ()
[(proc-name expr (... ...)) (proc expr (... ...))]
[proc-name proc]))]))
(make-mappy-macro macro-for-each begin (void))
(make-mappy-macro macro-map cons '())
;(define foo (λ(x) (add1 x)))
(define->macro foo (λ(x) (add1 x)))
(foo 4)
(map foo '(2 4 6))
(define-syntax-rule (add pair)
(+ (car pair) (cdr pair)))
;; this matches first case - why?
(macro-for-each add (list (cons 12 20)))
;(macro-map add (list 24 25 30))
;(macro-map add '(24 25 30))
;(macro-map-old add (list 24 25 30))
;(macro-for-each add '(24 25 30))
;(define (bar x) (add1 x))
(define->macro (bar x y) (+ x y))
(bar 4 1)
(map bar '(2 4 6) '(2 4 6))

Loading…
Cancel
Save