update

macro.rkt

@@ -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 define->macro  
-  (define-syntax mappy-macro-name
+  (syntax-rules ()
-    (syntax-id-rules ()
+    [(_ (proc-name arg ... . rest-arg) proc-expr ...) (define->macro proc-name (λ(arg ... . rest-arg) proc-expr ...))]
-      ;; convert quote form into list form
+    [(_ proc-name proc) (define-syntax proc-name 
-      [(_ macro-name (quote (items (... ...))))
+                          (syntax-id-rules ()
-       (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 (... ...))))])))
 
-(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)
+;(define (bar x) (add1 x))
-  (+ (car pair) (cdr pair)))
+(define->macro (bar x y) (+ x y))
-
-
-;; 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))