From 6e3cf95e8385f4d6084ad498c0f85b4ffd4f17e6 Mon Sep 17 00:00:00 2001 From: Jon Rafkind Date: Thu, 10 Nov 2011 15:55:30 -0700 Subject: [PATCH] [honu] parse bodies of macros early. re-parse the output of macros --- collects/honu/core/main.rkt | 4 +++- .../honu/core/private/honu-typed-scheme.rkt | 8 +++++++- collects/honu/core/private/macro2.rkt | 12 +++++++----- collects/honu/core/private/parse2.rkt | 18 +++++++++++++----- 4 files changed, 30 insertions(+), 12 deletions(-) diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index 785e2b69a3..b951c3fd94 100644 --- a/collects/honu/core/main.rkt +++ b/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] diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index d811d30dfd..25b28ee3d2 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/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)) diff --git a/collects/honu/core/private/macro2.rkt b/collects/honu/core/private/macro2.rkt index 5b6717deb8..b6a90df432 100644 --- a/collects/honu/core/private/macro2.rkt +++ b/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 parsed #'more #t) + (values (code ...) #'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)]))) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 22c373eb55..f7f86e85e3 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/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 rest ...) + [(%racket racket) + (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))]