[honu] macros can be defined with honu syntax

collects/honu/core/main.rkt

@@ -2,13 +2,18 @@
 
 (require "private/honu-typed-scheme.rkt"
          "private/honu2.rkt"
+         "private/macro2.rkt"
+         (for-syntax (only-in "private/parse2.rkt" honu-expression))
          (prefix-in literal: "private/literals.rkt"))
 
 (provide #%top
          #%datum
          print printf true false
+         (for-syntax (rename-out [honu-expression expression]))
          (rename-out [#%dynamic-honu-module-begin #%module-begin]
                      [honu-function function]
+                     [honu-macro macro]
+                     [honu-syntax syntax]
                      [honu-var var]
                      [honu-val val]
                      [honu-for for]
@@ -21,6 +26,7 @@
                      [honu-> >] [honu-< <]
                      [honu->= >=] [honu-<= <=]
                      [honu-= =]
+                     [honu-assignment :=]
                      [literal:honu-<- <-]
                      [honu-map map]
                      [honu-flow \|]

collects/honu/core/private/honu-typed-scheme.rkt

@@ -445,21 +445,22 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
          #'rest)])))
 
 (define-for-syntax (honu-expand forms)
-  (parse-all forms))
+  (parse-one forms))
 
 (define-for-syntax (honu-compile forms)
   #'(void))
 
-
 (define-syntax (honu-unparsed-begin stx)
   (emit-remark "Honu unparsed begin!" stx)
   (debug "honu unparsed begin: ~a at phase ~a\n" (syntax->datum stx) (syntax-local-phase-level))
   (syntax-parse stx
     [(_) #'(void)]
     [(_ forms ...)
-     (define expanded (honu-expand #'(forms ...)))
-     (debug "expanded ~a\n" (syntax->datum expanded))
-     expanded]))
+     (define-values (parsed unparsed) (honu-expand #'(forms ...)))
+     (debug "expanded ~a\n" (syntax->datum parsed))
+     (with-syntax ([parsed parsed]
+                   [(unparsed ...) unparsed])
+       #'(begin parsed (honu-unparsed-begin unparsed ...)))]))
 
 (define-syntax (#%dynamic-honu-module-begin stx)
   (syntax-case stx ()

collects/honu/core/private/macro2.rkt

@@ -3,6 +3,7 @@
 (require (for-syntax "transformer.rkt"
                      syntax/define
                      syntax/parse
+                     syntax/stx
                      "literals.rkt"
                      "parse2.rkt"
                      "debug.rkt"
@@ -17,30 +18,39 @@
       (syntax/loc stx
                  (define-syntax id (make-honu-transformer rhs))))))
 
-(define-for-syntax (convert-pattern pattern)
-  (syntax-parse pattern
-    [(name semicolon class)
-     #'(~var name class)]))
+(define-for-syntax (convert-pattern original-pattern)
+  (define-splicing-syntax-class pattern-type
+    #:literal-sets (cruft)
+    [pattern (~seq name colon class)
+             #:with result #'(~var name class #:attr-name-separator "_")]
+    [pattern x #:with result #'x])
+  (syntax-parse original-pattern
+    [(thing:pattern-type ...)
+     #'(thing.result ...)]))
 
-(provide macro)
-(define-honu-syntax macro 
+(provide honu-macro)
+(define-honu-syntax honu-macro 
   (lambda (code context)
     (debug "Macroize ~a\n" code)
     (syntax-parse code #:literal-sets (cruft)
       [(_ name literals (#%braces pattern ...) (#%braces action ...) . rest)
        (debug "Pattern is ~a\n" #'(pattern ...))
        (values
-         (with-syntax ([syntax-parse-pattern
+         (with-syntax ([(syntax-parse-pattern ...)
                          (convert-pattern #'(pattern ...))])
            #'(define-honu-syntax name
                (lambda (stx context-name)
                  (syntax-parse stx
-                   [(_ syntax-parse-pattern . more)
+                   [(_ syntax-parse-pattern ... . more)
                     (values #'(let-syntax ([do-parse (lambda (stx)
-                                                       (parse-all stx))])
+                                                       (define what (parse-all (stx-cdr stx)))
+                                                       (debug "Macro parse all ~a\n" what)
+                                                       what)])
                                 (do-parse action ...))
-                            #'more)]))))
-         #'rest)])))
+                            #'more
+                            #t)]))))
+         #'rest
+         #t)])))
 
 (provide (rename-out [honu-with-syntax withSyntax]))
 (define-honu-syntax honu-with-syntax
@@ -49,3 +59,18 @@
       [(_ [#%brackets name:id data]
           (#%braces code ...))
        #'(with-syntax ([name data]) code ...)])))
+
+(define-syntax (parse-stuff stx)
+  (syntax-parse stx
+    [(_ stuff ...)
+     (parse-all #'(stuff ...))]))
+
+(provide honu-syntax)
+(define-honu-syntax honu-syntax
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+      [(_ (#%parens stuff ...) . rest)
+       (values
+         #'(parse-stuff stuff ...)
+         #'rest
+         #f)])))

collects/honu/core/private/parse2.rkt

@@ -290,6 +290,10 @@
     [() #t]
     [else #f]))
 
+(provide parse-one)
+(define (parse-one code)
+  (parse (strip-stops code)))
+
 (define (parse-all code)
   (let loop ([all '()]
              [code code])