[honu] parse bodies of macros early. re-parse the output of macros

collects/honu/core/main.rkt

@@ -3,6 +3,7 @@
 (require "private/honu-typed-scheme.rkt"
          "private/honu2.rkt"
          "private/macro2.rkt"
+         (for-syntax (only-in "private/macro2.rkt" honu-syntax))
          "private/class.rkt"
          (for-syntax (only-in "private/parse2.rkt" honu-expression))
          (prefix-in literal: "private/literals.rkt"))
@@ -10,7 +11,8 @@
 (provide #%top
          #%datum
          print printf true false
-         (for-syntax (rename-out [honu-expression expression]))
+         (for-syntax (rename-out [honu-expression expression]
+                                 [honu-syntax syntax]))
          (rename-out [#%dynamic-honu-module-begin #%module-begin]
                      [honu-top-interaction #%top-interaction]
                      [honu-with-input-from-file with_input_from_file]

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

@@ -23,7 +23,7 @@
          "literals.rkt"
          "debug.rkt"
          ;; (prefix-in honu: "honu.rkt")
-         (prefix-in honu: "macro2.rkt")
+         ;; (prefix-in honu: "macro2.rkt")
          ;; "typed-utils.ss"
          )
 
@@ -294,6 +294,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
       (syntax/loc stx
                  (define-syntax id (make-honu-infix-transformer rhs))))))
 
+#;
 (honu:define-honu-syntax honu-macro-item
   (lambda (stx ctx)
     (syntax-parse stx
@@ -303,6 +304,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
        (values #'(define-syntax-class name [pattern x])
                #'rest)])))
 
+#;
 (honu:define-honu-syntax honu-scheme
   (lambda (stx ctx)
     (syntax-parse stx #:literals (semicolon)
@@ -311,6 +313,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
       [else (raise-syntax-error 'scheme "need a semicolon probably" stx)]
       )))
 
+#;
 (honu:define-honu-syntax honu-keywords
   (lambda (stx ctx)
     (syntax-parse stx #:literals (semicolon)
@@ -390,6 +393,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
      (parse-an-expr #'(expr ...))]
     [else (raise-syntax-error 'honu-unparsed-expr "Invalid expression syntax" stx)]))
 
+#;
 (honu:define-honu-syntax scheme-syntax
   (lambda (body ctx)
     (syntax-parse body
@@ -400,6 +404,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
            (apply-scheme-syntax #'#'template))
          #'rest)])))
 
+#;
 (honu:define-honu-syntax honu-provide
   (lambda (body ctx)
     (syntax-parse body #:literals (semicolon)
@@ -463,6 +468,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
     [x #'x]
     [() forms]))
 
+(provide honu-unparsed-begin)
 (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))

collects/honu/core/private/macro2.rkt

@@ -9,6 +9,8 @@
                      "debug.rkt"
                      racket/base)
          "literals.rkt"
+         #;
+         (for-syntax "honu-typed-scheme.rkt")
          syntax/parse)
 
 (provide define-honu-syntax)
@@ -38,13 +40,13 @@
        (debug "Pattern is ~a\n" #'(pattern ...))
        (values
          (with-syntax ([(syntax-parse-pattern ...)
-                        (convert-pattern #'(pattern ...))])
+                        (convert-pattern #'(pattern ...))]
+                       [(code ...) (parse-all #'(action ...))])
            #'(%racket (define-honu-syntax name
                         (lambda (stx context-name)
                           (syntax-parse stx
                             [(_ syntax-parse-pattern ... . more)
-                             (define parsed (parse-all #'(action ...)))
+                             (values (code ...) #'more #t)
-                             (values parsed #'more #t)
                              #;
                              (values #'(%racket
                                          (let-syntax ([do-parse (lambda (stx)
@@ -63,7 +65,7 @@
     (syntax-parse code #:literal-sets (cruft)
       [(_ [#%brackets name:id data]
           (#%braces code ...))
-       #'(%racket-expression (with-syntax ([name data]) code ...))])))
+       #'(%racket (with-syntax ([name data]) code ...))])))
 
 #;
 (define-syntax (parse-stuff stx)
@@ -78,7 +80,7 @@
     (syntax-parse code #:literal-sets (cruft)
       [(_ (#%parens stuff ...) . rest)
        (values
-         #'(stuff ...)
+         #'(%racket #'(stuff ...))
          #; #'(%racket-expression (parse-stuff stuff ...))
          #'rest
          #f)])))

collects/honu/core/private/parse2.rkt

@@ -200,11 +200,16 @@
             #;
             (do-parse #'(parsed ... rest ...)
                       precedence left current)
+            (define re-parse (let-values ([(re-parse re-unparse)
+                                           (parse #'parsed)])
+                               (with-syntax ([(re-parse* ...) re-parse]
+                                             [(re-unparse* ...) re-unparse])
+                                 #'(re-parse* ... re-unparse* ...))))
             (if terminate?
-              (values (left #'parsed)
+              (values (left re-parse)
                       #'rest)
               (do-parse #'rest precedence
-                        left #'parsed)))))))
+                        left re-parse)))))))
   (define (do-parse stream precedence left current)
     (define-syntax-class atom
       [pattern x:identifier]
@@ -219,8 +224,11 @@
       [()
        (values (left final) #'())]
       ;; dont reparse pure racket code
-      #;
+      [(%racket racket)
-      [(%racket racket rest ...)
+       (if current
+         (values (left current) stream)
+         (values (left stream) #'()))
+       #;
        (if current
          (values (left current) stream)
          (values (left #'racket) #'(rest ...)))]
@@ -300,7 +308,7 @@
                       #'rest)]
              [else (syntax-parse #'head
                      #:literal-sets (cruft)
-                     [(%racket rest ...)
+                     [(%racket x)
                       (if current
                         (values (left current) stream)
                         (do-parse #'(rest ...) precedence left #'head))]