allow comma in templates

collects/honu/core/private/macro.rkt

@@ -86,23 +86,52 @@
     [else (list)]))
 
 (define-for-syntax (fix-template stx)
-  (syntax-parse stx #:literals (honu-:)
+  (define (fix-classes stx)
-    [(variable:identifier honu-: class:identifier rest ...)
+    (syntax-parse stx #:literals (honu-:)
-     (with-syntax ([(rest* ...) (fix-template #'(rest ...))])
+      [(variable:identifier honu-: class:identifier rest ...)
-       (datum->syntax stx (cons #'(~var variable class #:attr-name-separator "_")
+       (with-syntax ([(rest* ...) (fix-template #'(rest ...))])
-                                #'(rest* ...))
+         (datum->syntax stx (cons #'(~var variable class #:attr-name-separator "_")
-                      stx)
+                                  #'(rest* ...))
-       #;
+                        stx)
-       #'((~var variable class) rest* ...))]
+         #;
-    [(one rest ...)
+         #'((~var variable class) rest* ...))]
-     (with-syntax ([one* (fix-template #'one)]
+      [(one rest ...)
-                   [(rest* ...) (fix-template #'(rest ...))])
+       (with-syntax ([one* (fix-template #'one)]
-       (datum->syntax stx (cons #'one*
+                     [(rest* ...) (fix-template #'(rest ...))])
-                                #'(rest* ...))
+         (datum->syntax stx (cons #'one*
-                      stx)
+                                  #'(rest* ...))
-       #;
+                        stx)
-       #'(one* rest* ...))]
+         #;
-    [else stx]))
+         #'(one* rest* ...))]
+      [else stx]))
+  ;; removes commas from a pattern
+  (define (fix-commas stx)
+    (syntax-parse stx
+      #:literals (honu-comma
+                   [ellipses ...])
+      [(a honu-comma ellipses rest ...)
+       (with-syntax ([a* (fix-commas #'a)]
+                     [(rest* ...) (fix-commas #'(rest ...))])
+         (datum->syntax stx
+                        `((~seq ,#'a* (~optional |,|)) ... ,@#'(rest* ...))
+                        stx stx)
+         #;
+         (datum->syntax stx
+                        (cons
+                          #'a*
+                          (cons
+                            #'(... ...)
+                            #'(rest* ...)))
+                        stx stx))]
+      [(z rest ...)
+       (with-syntax ([z* (fix-commas #'z)]
+                     [(rest* ...) (fix-commas #'(rest ...))])
+         (datum->syntax stx
+                        (cons #'z* #'(rest* ...))
+                        stx stx))]
+      [else stx]))
+  (define all-fixes (compose fix-commas fix-classes))
+  (all-fixes stx))
 
 #|
 (define-for-syntax (fix-template stx)
@@ -466,11 +495,25 @@
 
 (define foobar 0)
 
-
 (define-honu-syntax honu-macro
   (lambda (stx ctx)
     (define-splicing-syntax-class patterns
                          #:literal-sets ([cruft #:phase (syntax-local-phase-level)])
+      #;
+      [pattern (~seq x ...)
+               #:with (template ...) '()
+               #:with (code ...) '()
+               #:with (fixed ...) '()
+               #:when (begin
+                        (printf "Trying to parse ~a\n" (syntax->datum #'(x ...)))
+                        #f)]
+      #;
+      [pattern (~seq (#%braces template ...)
+                     (#%braces code ...))
+               #:with (fixed ...) '()
+               #:when (begin
+                        (printf "Got template as ~a. Code is ~a\n" (syntax->datum #'(template ...)) (syntax->datum #'(code ...)))
+                        #f)]
       [pattern (~seq (#%braces template ...)
                      (#%braces code ...))
                #:with (fixed ...) (fix-template #'(template ...))])
@@ -495,7 +538,7 @@
                                [your-braces (datum->syntax #'name '#%braces #'name)]
                                #;
                                [your-parens (datum->syntax #'name '#%parens #'name)])
-
+                   ;;(printf "Ok macro3 go!\n")
                    #;
                    #'(define-honu-syntax name
                        (lambda (stx ctx)
@@ -517,6 +560,7 @@
                                  (lambda (stx ctx)
                                    #;
                                    (printf "Executing macro `~a' on input `~a'\n" 'name (syntax->datum stx))
+                                   (printf "~a pattern is ~a\n" 'name '(pattern.fixed ... ...))
                                    (syntax-parse stx
                                      #:literal-sets ([cruft #:at name])
                                      #:literals (foobar literals ...)

collects/honu/core/private/parse.rkt

@@ -149,7 +149,7 @@
                     #f)]
 
   [pattern (~seq (~var e (expression-simple context))
-                 (~var dx (debug-here (format "call 1 ~a" #'e)))
+                 (~var dx (debug-here (format "call 1 ~a" (syntax->datum #'e))))
                  (#%parens 
                   (~seq (~var dz (debug-here (format "call 2")))
                         (~var arg (ternary context))
@@ -346,7 +346,7 @@
 (define-splicing-syntax-class (ternary context)
                               #:literals (honu-? honu-:)
                               [pattern (~seq (~var condition (expression-1 context))
-                                             (~var x1 (debug-here (format "ternary 1 ~a\n" #'condition.result)))
+                                             (~var x1 (debug-here (format "ternary 1 ~a\n" (syntax->datum #'condition.result))))
                                              (~optional (~seq honu-? (~var on-true (ternary context))
                                                               honu-: (~var on-false (ternary context))))
                                              (~var x2 (debug-here "ternary 2"))

collects/honu/private/function.honu

@@ -2,8 +2,8 @@
 
 provide function;
 macro function ()
-  { _ name:identifier (args:identifier ...) { body ... } }
+  { _ name:identifier (args:identifier , ...) { body ... } }
   { #sx scheme:syntax #sx(define (name_result args_result ...)
                          (honu-unparsed-begin body ...)) }
-  { _ (args:identifier ...) { body ... }}
+  { _ (args:identifier , ...) { body ... }}
   { #sx scheme:syntax #sx(lambda (args_result ...) (honu-unparsed-begin body ...)) }

collects/honu/private/struct.honu

@@ -4,7 +4,7 @@ require (forSyntax "struct-patterns.honu");
 
 provide struct;
 macro struct () {
-  _ name {field:structField ...} ;
+  _ name {field:structField, ...} ;
 } {
   schemeSyntax#sx(honu-struct name (field_name_result ...))
 }