[honu] add primitive macro form

collects/honu/core/main.rkt

@@ -33,6 +33,7 @@
                                    [honu-new new]
                                    [honu-while while]
                                    [honu-macro macro]
+                                   [honu-primitive-macro primitive_macro]
                                    [honu-pattern pattern]
                                    [racket:read-line readLine]
                                    [honu-with-input-from-file withInputFromFile]

collects/honu/core/private/compile.rkt

@@ -111,7 +111,9 @@
     syntax))
 
 (define (parsed-syntax? syntax)
-  (syntax-property syntax parsed-property))
+  (if syntax
+    (syntax-property syntax parsed-property)
+    syntax))
 
 (define-syntax (racket-syntax stx)
   (syntax-case stx ()

collects/honu/core/private/honu2.rkt

@@ -41,7 +41,7 @@
 (define-syntax (parse-body stx)
   (syntax-parse stx
     [(_ stuff ...)
-     (honu->racket (parse-all #'(stuff ...)))]))
+     (parse-all #'(stuff ...))]))
 
 (provide honu-function)
 (define-honu-syntax honu-function
@@ -269,9 +269,6 @@
                              #'name)
              #:when (not ((literal-set->predicate cruft) #'x))]))
 
-(define-for-syntax (racket-names->honu name)
-  (regexp-replace* #rx"-" "_"))
-
 (provide honu-require)
 (define-honu-syntax honu-require
   (lambda (code)
@@ -456,3 +453,14 @@
                             body.result))
                #'rest
                #t)])))
+
+(provide honu-primitive-macro)
+(define-honu-syntax honu-primitive-macro
+  (lambda (code)
+    (syntax-parse code
+      [(_ name:id transformer:honu-expression/phase+1 . rest)
+       (values
+         (racket-syntax (define-honu-syntax name transformer.result))
+         #'rest
+         #t)])))
+

collects/honu/core/private/parse2.rkt

@@ -347,13 +347,14 @@
     (debug "parse ~a precedence ~a left ~a current ~a properties ~a\n"
            (syntax->datum stream) precedence left current
            (syntax-property-symbol-keys stream))
-    (define final (if current current #f))
+    (define final (if current current #'(void)))
     (if (parsed-syntax? stream)
       (values (left stream) #'())
     (syntax-parse stream #:literal-sets (cruft)
       #;
       [x:id (values #'x #'())]
       [()
+       (debug "Empty input out: left ~a ~a\n" left (left final))
        (values (left final) #'())]
       ;; dont reparse pure racket code
       [(%racket racket)