From 4799d080222ddce6f20c44d781d3ff5e0b8f26dc Mon Sep 17 00:00:00 2001
From: Jon Rafkind <rafkind@racket-lang.org>
Date: Mon, 23 Apr 2012 16:43:27 -0600
Subject: [PATCH] [honu] dont splice the output of a macro directly into the
 output

---
 collects/honu/core/main.rkt           |  2 ++
 collects/honu/core/private/macro2.rkt |  1 +
 collects/honu/core/private/parse2.rkt | 22 ++++++++++++++++++++--
 collects/honu/main.rkt                |  3 ++-
 4 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt
index ce6008545c..b1ae0eb9fe 100644
--- a/collects/honu/core/main.rkt
+++ b/collects/honu/core/main.rkt
@@ -5,6 +5,7 @@
     (require (for-meta meta-level
                        racket/base
                        racket/class
+                       (prefix-in list: racket/list)
                        "private/macro2.rkt"
                        "private/class.rkt"
                        "private/operator.rkt"
@@ -87,6 +88,7 @@
                          [datum->syntax datum_to_syntax]
                          [syntax->datum syntax_to_datum]
                          [syntax->list syntax_to_list]
+                         [list:first first]
                          [symbol->string symbol_to_string]
                          [string-append string_append])
                        print printf
diff --git a/collects/honu/core/private/macro2.rkt b/collects/honu/core/private/macro2.rkt
index 9bd205732b..04f0ab2ca8 100644
--- a/collects/honu/core/private/macro2.rkt
+++ b/collects/honu/core/private/macro2.rkt
@@ -212,6 +212,7 @@
 (define-honu-syntax honu-syntax
   (lambda (code context)
     (syntax-parse code #:literal-sets (cruft)
+      #;
       [(_ (#%parens single) . rest)
        (define context #'single)
        (define compressed (phase0:compress-dollars #'single))
diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt
index a39603faf7..204069fc93 100644
--- a/collects/honu/core/private/parse2.rkt
+++ b/collects/honu/core/private/parse2.rkt
@@ -166,12 +166,18 @@
        (if (null? (syntax->datum #'(unparsed-out ...)))
          (if (parsed-syntax? #'output)
            #'output
+           #;
+           #'(parse-more output)
            (with-syntax ([(out ...) #'output])
              #'(parse-more out ...)))
+         #;
+         #'(begin (parse-more output unparsed-out ...))
          (if (parsed-syntax? #'output)
            #'(begin output (parse-more unparsed-out ...))
+           #;
+           #'(parse-more output unparsed-out ...)
            (with-syntax ([(out ...) #'output])
-             #'(parse-more out ... unparsed-out ...)))))]
+             #'(begin (parse-more out ...) (parse-more unparsed-out ...))))))]
     [() #'(begin)]))
 
 (define (do-parse-rest/local stx)
@@ -398,7 +404,7 @@
                                         (define output
                                           (if current
                                             (if binary-transformer
-                                              (binary-transformer (parse-all current) right)
+                                              (binary-transformer (parse-all-expression current) right)
                                               (error 'binary "cannot be used as a binary operator in ~a" #'head))
                                             (if unary-transformer
                                               (unary-transformer right)
@@ -447,6 +453,8 @@
              [body:honu-body
                (if current
                  (values (left current) stream)
+                 (values (left #'body.result) #'())
+                 #;
                  (do-parse #'(rest ...) precedence left #'body.result))]
              #;
              [((semicolon more ...) . rest)
@@ -582,6 +590,16 @@
 (define (parse-one code)
   (parse (strip-stops code)))
 
+;; keep parsing some expression until only a parsed term remains
+(define (parse-all-expression code)
+  (define-values (parsed unparsed)
+                 (parse code))
+  (when (not (empty-syntax? unparsed))
+    (raise-syntax-error 'parse-all-expression "expected no more syntax" code))
+  (if (parsed-syntax? parsed)
+    parsed
+    (parse-all-expression parsed)))
+
 (define (parse-all code)
   (let loop ([all '()]
              [code code])
diff --git a/collects/honu/main.rkt b/collects/honu/main.rkt
index 47be088fca..f9f2d217f6 100644
--- a/collects/honu/main.rkt
+++ b/collects/honu/main.rkt
@@ -32,11 +32,13 @@
          values
          hash
          regexp
+         error
          (racket:rename-out
            [honu-cond cond]
            [null empty]
            [make-hash mutable_hash]
            [hash-set! hash_update]
+           [hash-ref hash_lookup]
            [current-inexact-milliseconds currentMilliseconds]
            [string-length string_length]
            [string-append string_append]
@@ -44,5 +46,4 @@
            [racket:find-files find_files]
            [racket:empty? empty?]
            [regexp-match regexp_match]
-           [racket:first first]
            [racket:rest rest]))