From 4b4a369d847b7bb80251983fe2d6d03c14b05014 Mon Sep 17 00:00:00 2001
From: Jon Rafkind <rafkind@racket-lang.org>
Date: Mon, 21 Nov 2011 14:12:38 -0700
Subject: [PATCH] [honu] abstract out delayed parsing

---
 collects/honu/core/private/parse2.rkt | 53 +++++++++++++++------------
 1 file changed, 30 insertions(+), 23 deletions(-)

diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt
index 350951af93..912e991674 100644
--- a/collects/honu/core/private/parse2.rkt
+++ b/collects/honu/core/private/parse2.rkt
@@ -163,35 +163,40 @@
                    [(unparsed-out ...) unparsed])
        #'(begin parsed-out ... (parse-stuff unparsed-out ...)))]))
 
+(define (do-parse stx parse-more)
+  (syntax-parse stx
+    [(_ stuff ...)
+     (define-values (parsed unparsed)
+                    (parse (strip-stops #'(stuff ...))))
+     (debug "Parse more: ~a unparsed ~a\n" parsed unparsed)
+     (define output (if parsed
+                      (honu->racket parsed)
+                      #'(begin)))
+     (debug "Output ~a\n" output)
+     (with-syntax ([output output]
+                   [(unparsed-out ...) unparsed]
+                   [parse-more parse-more])
+       (if (null? (syntax->datum #'(unparsed-out ...)))
+         #'output
+         #'(begin output (parse-more unparsed-out ...))))]))
+
+(provide honu-body)
+(define-syntax-class honu-body
+  #:literal-sets (cruft)
+  [pattern (#%braces code ...)
+           #:with result #'(begin
+                             (define-syntax (parse-more stx)
+                               (do-parse stx #'parse-more))
+                             (parse-more code ...))])
+
 (provide honu-function)
 (define-splicing-syntax-class honu-function #:literal-sets (cruft)
-  [pattern (~seq function:identifier (#%parens args ...) (#%braces code ...))
+  [pattern (~seq function:identifier (#%parens args ...) body:honu-body)
            #:with result
            (with-syntax ([(parsed-arguments ...)
                           (parse-arguments #'(args ...))])
              #'(define (function parsed-arguments ...)
-                 (define-syntax (parse-more stx)
-                   (syntax-parse stx
-                     [(_ stuff (... ...))
-                      (define-values (parsed unparsed)
-                                     (parse (strip-stops #'(stuff (... ...)))))
-                      (debug "Parse more: ~a unparsed ~a\n" parsed unparsed)
-                      (define output (if parsed
-                                       (honu->racket parsed)
-                                       #'(begin)))
-                      (debug "Output ~a\n" output)
-                      (with-syntax ([output output]
-                                    [(unparsed-out (... ...)) unparsed])
-                        (if (null? (syntax->datum #'(unparsed-out (... ...))))
-                          #'output
-                          #'(begin output (parse-more unparsed-out (... ...)))))]))
-                 (parse-more code ...)
-                 #;
-                 (let-syntax ([parse-more (lambda (stx)
-                                            ;; this adds an extra mark, you might not
-                                            ;; want that
-                                            (honu->racket (parse-all #'(code ...))))])
-                   (parse-more))))])
+                 body.result))])
 
 ;; E = macro
 ;;   | E operator E
@@ -517,6 +522,7 @@
 (define-splicing-syntax-class honu-expression/comma
   [pattern (~seq x ...) #:with (result ...) (parse-comma-expression #'(x ...))])
 
+#|
 (provide honu-body)
 (define-splicing-syntax-class honu-body
                               #:literal-sets (cruft)
@@ -524,4 +530,5 @@
            #:with result #'(let-syntax ([parse-more (lambda (stx)
                                                       (honu->racket (parse-all #'(code ...))))])
                              (parse-more))])
+|#