update
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
|
||||
(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 ()
|
||||
;; convert quote form into list form
|
||||
[(_ macro-name (quote (items (... ...))))
|
||||
(mappy-macro-name macro-name (list items (... ...)))]
|
||||
[(proc-name expr (... ...)) (proc expr (... ...))]
|
||||
[proc-name proc]))]))
|
||||
|
||||
;; 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 foo (λ(x) (add1 x)))
|
||||
(define->macro foo (λ(x) (add1 x)))
|
||||
|
||||
(make-mappy-macro macro-for-each begin (void))
|
||||
(make-mappy-macro macro-map cons '())
|
||||
(foo 4)
|
||||
(map foo '(2 4 6))
|
||||
|
||||
;(define (bar x) (add1 x))
|
||||
(define->macro (bar x y) (+ x y))
|
||||
|
||||
|
||||
(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))
|
||||
|
||||
(bar 4 1)
|
||||
(map bar '(2 4 6) '(2 4 6))
|
||||
|
Loading…
Reference in New Issue