[honu] dont parse the output of syntax too early. wrap some core racket forms with %racket

collects/honu/core/private/debug.rkt

@@ -9,6 +9,28 @@
                  (split-path (build-path path)))
   name)
 
+(define (colorize string color)
+  (define colors (hash 'none "0"
+                       'black "0;30"
+                       'red "0;31"
+                       'green "0;32"
+                       'brown "0;33"
+                       'blue "0;34"
+                       'purple "0;35"
+                       'cyan "0;36"
+                       'light-gray "0;37"
+                       'dark-gray "1:30"
+                       'light-red "1;31"
+                       'light-green "1;32"
+                       'yellow "1;33"
+                       'light-blue "1;34"
+                       'light-purple "1;35"
+                       'light-cyan "1;36"
+                       'white "1;37"))
+  (define (get-color color)
+    (hash-ref colors color (lambda () "0")))
+  (format "\033[~am~a\033[0m" (get-color color) string))
+
 (define-for-syntax verbose? (getenv "HONU_DEBUG"))
 (define-syntax (debug stx)
   (if verbose?
@@ -17,6 +39,10 @@
        (with-syntax ([file (filename (syntax-source #'str))]
                      [line (syntax-line #'str)]
                      [column (syntax-column #'str)])
-         #'(printf (string-append "~a at ~a:~a " str) file line column x ...))])
+         #'(printf (string-append "~a at ~a:~a " str)
+                   (colorize file 'green)
+                   (colorize line 'red)
+                   (colorize column 'red)
+                   x ...))])
     #'(void)))
 

collects/honu/core/private/honu2.rkt

@@ -53,8 +53,12 @@
       [(_ iterator:id honu-= start:honu-expression honu-to end:honu-expression
           honu-do body:honu-expression . rest)
        (values
-         #'(%racket (for ([iterator (in-range start.result end.result)])
+         (with-syntax ([start-parsed (parse-all #'start.result)]
-                      body.result))
+                       [end-parsed (parse-all #'end.result)]
+                       [body-parsed (parse-all #'body.result)])
+           #'(%racket (for ([iterator (in-range start-parsed
+                                                end-parsed)])
+                        body-parsed)))
          #'rest
          #t)]
       [(_ iterator:id honu-in stuff:honu-expression

collects/honu/core/private/macro2.rkt

@@ -8,6 +8,7 @@
                      "parse2.rkt"
                      "debug.rkt"
                      racket/base)
+         "literals.rkt"
          syntax/parse)
 
 (provide define-honu-syntax)
@@ -38,17 +39,21 @@
        (values
          (with-syntax ([(syntax-parse-pattern ...)
                         (convert-pattern #'(pattern ...))])
-           #'(define-honu-syntax name
+           #'(%racket (define-honu-syntax name
                         (lambda (stx context-name)
                           (syntax-parse stx
                             [(_ syntax-parse-pattern ... . more)
-                    (values #'(let-syntax ([do-parse (lambda (stx)
+                             (define parsed (parse-all #'(action ...)))
+                             (values parsed #'more #t)
+                             #;
+                             (values #'(%racket
+                                         (let-syntax ([do-parse (lambda (stx)
                                                                   (define what (parse-all (stx-cdr stx)))
                                                                   (debug "Macro parse all ~a\n" what)
                                                                   what)])
-                                (do-parse action ...))
+                                           (do-parse action ...)))
                                      #'more
-                            #t)]))))
+                                     #t)])))))
          #'rest
          #t)])))
 
@@ -58,19 +63,22 @@
     (syntax-parse code #:literal-sets (cruft)
       [(_ [#%brackets name:id data]
           (#%braces code ...))
-       #'(with-syntax ([name data]) code ...)])))
+       #'(%racket-expression (with-syntax ([name data]) code ...))])))
 
+#;
 (define-syntax (parse-stuff stx)
   (syntax-parse stx
     [(_ stuff ...)
      (parse-all #'(stuff ...))]))
 
 (provide honu-syntax)
+;; Do any honu-specific expansion here
 (define-honu-syntax honu-syntax
   (lambda (code context)
     (syntax-parse code #:literal-sets (cruft)
       [(_ (#%parens stuff ...) . rest)
        (values
-         #'(parse-stuff stuff ...)
+         #'(stuff ...)
+         #; #'(%racket-expression (parse-stuff stuff ...))
          #'rest
          #f)])))

collects/honu/core/private/parse2.rkt

@@ -8,6 +8,7 @@
          "literals.rkt"
          "debug.rkt"
          (prefix-in transformer: "transformer.rkt")
+         racket/pretty
          syntax/stx
          syntax/parse/experimental/splicing
          syntax/parse)
@@ -17,9 +18,10 @@
 ;; phase -1
 (require (for-template racket/base
                        racket/splicing
+                       (only-in "literals.rkt" %racket-expression)
                        "extra.rkt"))
 
-(provide parse parse-all)
+(provide parse parse-all parse-all)
 
 #;
 (define-literal-set literals
@@ -148,6 +150,13 @@
                                             (parse-all #'(code ...)))])
                    (parse-more))))])
 
+;; E = macro
+;;   | E operator E
+;;   | [...]
+;;   | f(...)
+;;   | { ... }
+;;   | (...)
+
 ;; 1 + 1
 ;; ^
 ;;  left: identity
@@ -187,7 +196,7 @@
                        #f)])
           (with-syntax ([(parsed ...) parsed]
                         [(rest ...) unparsed])
-            (debug "Output from macro ~a\n" #'(parsed ...))
+            (debug "Output from macro ~a\n" (pretty-format (syntax->datum #'(parsed ...))))
             (do-parse #'(parsed ... rest ...)
                       precedence left current)
             #;
@@ -213,12 +222,18 @@
          (values (left current) stream)
          (values (left #'racket) #'(rest ...)))]
       ;; for expressions that can keep parsing
-      [(%racket-expression racket rest ...)
+      [((%racket-expression racket) rest ...)
        (if current
          (values (left current) stream)
          (do-parse #'(rest ...)
                    precedence left
                    #'racket))]
+      [(%racket-expression racket)
+       (if current
+         (values (left current) stream)
+         (do-parse #'()
+                   precedence left
+                   #'racket))]
       [(head rest ...)
        (cond
          [(honu-macro? #'head)
@@ -397,7 +412,8 @@
     (define-values (parsed unparsed)
                    (parse stx))
     (debug "parsed ~a\n" (if parsed (syntax->datum parsed) parsed))
-    (list (parsed-things stx unparsed) parsed)))
+    (list (parsed-things stx unparsed) (with-syntax ([parsed parsed])
+                                         #'(%racket-expression parsed)))))
 
 (provide identifier-comma-list)
 (define-splicing-syntax-class identifier-comma-list

collects/tests/honu/macros.rkt

@@ -2,7 +2,7 @@
 
 macro testx () {x:expression} {syntax(x_result + 1)}
 
-testx 5 * 2;
+testx 5 * 2
 
 for z = 1 to testx 5 * 2 do
   printf("z is ~a\n", z)