From 5aa6b0b06e764f173855d8816ad539ac964bec6e Mon Sep 17 00:00:00 2001 From: Jon Rafkind Date: Tue, 8 Nov 2011 14:10:58 -0700 Subject: [PATCH] [honu] dont parse the output of syntax too early. wrap some core racket forms with %racket --- collects/honu/core/private/debug.rkt | 28 ++++++++++++++++++++- collects/honu/core/private/honu2.rkt | 8 ++++-- collects/honu/core/private/macro2.rkt | 36 ++++++++++++++++----------- collects/honu/core/private/parse2.rkt | 24 +++++++++++++++--- collects/tests/honu/macros.rkt | 2 +- 5 files changed, 76 insertions(+), 22 deletions(-) diff --git a/collects/honu/core/private/debug.rkt b/collects/honu/core/private/debug.rkt index 5eb9ad0c72..3f602ecdc7 100644 --- a/collects/honu/core/private/debug.rkt +++ b/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))) diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index cb2c4f9e41..2aea36274d 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/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)]) - body.result)) + (with-syntax ([start-parsed (parse-all #'start.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 diff --git a/collects/honu/core/private/macro2.rkt b/collects/honu/core/private/macro2.rkt index 60a799978a..5b6717deb8 100644 --- a/collects/honu/core/private/macro2.rkt +++ b/collects/honu/core/private/macro2.rkt @@ -8,6 +8,7 @@ "parse2.rkt" "debug.rkt" racket/base) + "literals.rkt" syntax/parse) (provide define-honu-syntax) @@ -37,18 +38,22 @@ (debug "Pattern is ~a\n" #'(pattern ...)) (values (with-syntax ([(syntax-parse-pattern ...) - (convert-pattern #'(pattern ...))]) - #'(define-honu-syntax name - (lambda (stx context-name) - (syntax-parse stx - [(_ syntax-parse-pattern ... . more) - (values #'(let-syntax ([do-parse (lambda (stx) - (define what (parse-all (stx-cdr stx))) - (debug "Macro parse all ~a\n" what) - what)]) - (do-parse action ...)) - #'more - #t)])))) + (convert-pattern #'(pattern ...))]) + #'(%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 #'(%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 ...))) + #'more + #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)]))) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 75a9c1b337..d4119566aa 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/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 diff --git a/collects/tests/honu/macros.rkt b/collects/tests/honu/macros.rkt index cc9255503a..44bd25ffab 100644 --- a/collects/tests/honu/macros.rkt +++ b/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)