From 249c7b02cacf13aa02998c2ef75458b29a54002a Mon Sep 17 00:00:00 2001 From: Jon Rafkind Date: Mon, 5 Mar 2012 12:32:35 -0700 Subject: [PATCH] [honu] use syntax properties to differentiate parsed syntax from unparsed --- collects/honu/core/private/compile.rkt | 39 +- .../honu/core/private/honu-typed-scheme.rkt | 12 +- collects/honu/core/private/honu2.rkt | 18 +- collects/honu/core/private/macro2.rkt | 53 +-- collects/honu/core/private/operator.rkt | 8 +- collects/honu/core/private/parse2.rkt | 84 ++-- collects/honu/private/common.rkt | 9 +- collects/scribblings/guide/macros.scrbl | 1 + collects/scribblings/guide/phases.scrbl | 374 ++++++++++++++++++ collects/tests/honu/match.honu | 2 +- 10 files changed, 517 insertions(+), 83 deletions(-) create mode 100644 collects/scribblings/guide/phases.scrbl diff --git a/collects/honu/core/private/compile.rkt b/collects/honu/core/private/compile.rkt index 58d2c6e78a..d3aa746a97 100644 --- a/collects/honu/core/private/compile.rkt +++ b/collects/honu/core/private/compile.rkt @@ -41,6 +41,25 @@ (define-syntax repeat$ (lambda (stx) (raise-syntax-error 'repeat$ "dont use this"))) +(define (remove-repeats input) + (debug 2 "Remove repeats from ~a\n" (syntax->datum input)) + (debug 2 "Properties ~a\n" (syntax-property-symbol-keys input)) + (define-literal-set locals (repeat$)) + (syntax-parse input #:literal-sets ([locals #:at input]) + [(out ... ((~literal repeat$) stuff ...) rest ...) + (debug 2 " Found a repeat\n") + (with-syntax ([(out* ...) (map remove-repeats (syntax->list #'(out ...)))] + [(rest* ...) (map remove-repeats (syntax->list #'(rest ...)))]) + (remove-repeats (datum->syntax input + (syntax->list #'(out* ... stuff ... rest* ...)) + input input)))] + [(normal ...) (with-syntax ([(normal* ...) (map remove-repeats (syntax->list #'(normal ...)))]) + (datum->syntax input + (syntax->list #'(normal* ...)) + input input))] + [x #'x] + [else (raise-syntax-error 'repeats "unhandled case" input)])) + (define-syntax (unexpand-honu-syntax stx) (define (remove-repeats input) (debug 2 "Remove repeats from ~a\n" (syntax->datum input)) @@ -67,7 +86,8 @@ (debug "Expand honu syntax at phase ~a\n" (syntax-local-phase-level)) #; (debug " Is ~a expanded ~a\n" (syntax->datum #'expr) (syntax->datum #'#'expr)) - (emit-remark "Unexpand honu syntax" #'expr) + (emit-remark (format "Unexpand honu syntax at phase ~a" (syntax-local-phase-level)) + #'expr) #; (syntax-case #'expr () [(_ what) (debug "Properties on ~a are ~a\n" #'what (syntax-property-symbol-keys #'what))]) @@ -94,3 +114,20 @@ [(_ form) #'(parsed-syntax #'form)])) +(begin-for-syntax + (provide compress-dollars) + (define (compress-dollars stx) + (define-literal-set local-literals (honu-$ repeat$)) + (syntax-parse stx #:literal-sets (local-literals) + [(honu-$ x ... honu-$ rest ...) + (with-syntax ([(rest* ...) (compress-dollars #'(rest ...))]) + (datum->syntax stx (syntax->list #'((repeat$ x ...) rest* ...)) + stx stx))] + [(x rest ...) + (with-syntax ([x* (compress-dollars #'x)] + [(rest* ...) (compress-dollars #'(rest ...))]) + (datum->syntax stx + (syntax->list #'(x* rest* ...)) + stx stx))] + [x #'x]))) + diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index e618d501de..8cc4522a1f 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/collects/honu/core/private/honu-typed-scheme.rkt @@ -476,14 +476,20 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt ;; so use an empty form, begin, `parsed' could be #f becuase there was no expression ;; in the input such as parsing just ";". (with-syntax ([parsed (if (not parsed) #'(begin) - parsed + (remove-repeats parsed) #; (honu->racket parsed))] [(unparsed ...) unparsed]) (debug "Final parsed syntax\n~a\n" (pretty-format (syntax->datum #'parsed))) (if (null? (syntax->datum #'(unparsed ...))) - #'parsed - #'(begin parsed (honu-unparsed-begin unparsed ...))))])) + (if (parsed-syntax? #'parsed) + #'parsed + (with-syntax ([(out ...) #'parsed]) + #'(honu-unparsed-begin out ...))) + (if (parsed-syntax? #'parsed) + #'(begin parsed (honu-unparsed-begin unparsed ...)) + (with-syntax ([(out ...) #'parsed]) + #'(honu-unparsed-begin out ... unparsed ...)))))])) (define-syntax (#%dynamic-honu-module-begin stx) (syntax-case stx () diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index 4ee011bd68..61d821ef3c 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -68,7 +68,7 @@ [(_ (#%parens condition:honu-expression) true:honu-expression (~optional else) false:honu-expression . rest) (values - (racket-syntax (if (let () condition.result) (let () true.result) (let () false.result))) + (racket-syntax (if condition.result true.result false.result)) #'rest #f)]))) @@ -228,11 +228,11 @@ (provide honu-provide) (define-honu-syntax honu-provide (lambda (code context) - (syntax-parse code - [(_ name:id ...) - (define out (parsed-syntax #'(provide name ...))) + (syntax-parse code #:literal-sets (cruft) + [(_ name:id ... (~optional semicolon) . rest) + (define out (racket-syntax (provide name ...))) (debug "Provide properties ~a\n" (syntax-property-symbol-keys out)) - (values out #'() #f)]))) + (values out #'() #'rest)]))) (provide honu-with-input-from-file) (define-honu-syntax honu-with-input-from-file @@ -288,7 +288,7 @@ (syntax-parse rest #:literal-sets (cruft) [(_ name:identifier (#%parens argument:honu-expression/comma) . more) (with-syntax ([left left]) - (values #'(send/apply left name (list argument.result ...)) + (values (racket-syntax (send/apply left name (list argument.result ...))) #'more))]))) (begin-for-syntax @@ -359,10 +359,8 @@ #:literals (honu-in) [(_ (~seq iterator:id honu-in stuff:honu-expression (~optional honu-comma)) ... honu-do body:honu-expression . rest) - (values (with-syntax ([(stuff.result ...) (map honu->racket (syntax->list #'(stuff.result ...)))] - [body.result (honu->racket #'body.result)]) - (racket-syntax (for ([iterator stuff.result] ...) - body.result))) + (values (racket-syntax (for ([iterator stuff.result] ...) + body.result)) #'rest #t)]))) diff --git a/collects/honu/core/private/macro2.rkt b/collects/honu/core/private/macro2.rkt index 79c1654158..b218df1653 100644 --- a/collects/honu/core/private/macro2.rkt +++ b/collects/honu/core/private/macro2.rkt @@ -6,17 +6,18 @@ racket/set racket/syntax "literals.rkt" - "parse2.rkt" + (prefix-in phase1: "parse2.rkt") "debug.rkt" - "compile.rkt" + (prefix-in phase1: "compile.rkt") "util.rkt" (prefix-in syntax: syntax/parse/private/residual-ct) racket/base) (for-meta 2 syntax/parse racket/base macro-debugger/emit - "parse2.rkt" - "compile.rkt") + (prefix-in phase2: "parse2.rkt") + (prefix-in phase2: "compile.rkt")) + (prefix-in phase0: "compile.rkt") "literals.rkt" "syntax.rkt" "debug.rkt" @@ -127,7 +128,7 @@ (syntax-parse stx [(_ stuff ...) (emit-remark "Parse stuff ~a\n" #'(stuff ...)) - (parse-all #'(stuff ...)) + (phase2:parse-all #'(stuff ...)) #; (honu->racket (parse-all #'(stuff ...)))]))) @@ -165,7 +166,7 @@ ))]) #'(name name.result)))]) (debug "Done with syntax\n") - (racket-syntax + (phase1:racket-syntax (define-honu-syntax name (lambda (stx context-name) (define-literal-set local-literals (literal ...)) @@ -187,28 +188,32 @@ #'rest #t)]))) +;; FIXME: we shouldn't need this definition here +(define-syntax (as-honu-syntax stx) + (syntax-parse stx + [(_ form) + (define compressed (phase0:compress-dollars #'form)) + (with-syntax ([stuff* (datum->syntax #'form (syntax->list compressed) + #'form #'form)]) + (syntax #'stuff*))])) + +(begin-for-syntax + (define-syntax (as-honu-syntax stx) + (syntax-parse stx + [(_ form) + (define compressed (phase1:compress-dollars #'form)) + (with-syntax ([stuff* (datum->syntax #'form (syntax->list compressed) + #'form #'form)]) + (syntax #'stuff*))]))) + (provide honu-syntax) ;; Do any honu-specific expansion here (define-honu-syntax honu-syntax (lambda (code context) - (define (compress-dollars stx) - (define-literal-set local-literals (honu-$)) - (syntax-parse stx #:literal-sets (local-literals) - [(honu-$ x ... honu-$ rest ...) - (with-syntax ([(rest* ...) (compress-dollars #'(rest ...))]) - (datum->syntax stx (syntax->list #'((repeat$ x ...) rest* ...)) - stx stx))] - [(x rest ...) - (with-syntax ([x* (compress-dollars #'x)] - [(rest* ...) (compress-dollars #'(rest ...))]) - (datum->syntax stx - (syntax->list #'(x* rest* ...)) - stx stx))] - [x #'x])) (syntax-parse code #:literal-sets (cruft) [(_ (#%parens stuff ...) . rest) (define context (stx-car #'(stuff ...))) - (define compressed (compress-dollars #'(stuff ...))) + (define compressed (phase0:compress-dollars #'(stuff ...))) (values (with-syntax ([stuff* (datum->syntax context (syntax->list compressed) @@ -216,7 +221,7 @@ ;; (debug "Stuff is ~a\n" (syntax->datum #'stuff*)) ;; (debug "Stuff syntaxed is ~a\n" (syntax->datum #'#'stuff*)) (with-syntax ([(out ...) #'stuff*]) - (racket-syntax #'stuff*))) + (phase1:racket-syntax #'stuff*))) #; #'(%racket-expression (parse-stuff stuff ...)) #'rest #f)]))) @@ -308,9 +313,9 @@ [((withs ...) ...) (set->list withs)] [(result-with ...) (if maybe-out (with-syntax ([(out ...) maybe-out]) - #'(#:with result (syntax out ...))) + #'(#:with result (as-honu-syntax out ...))) #'(#:with result #'()))]) - #'(%racket (begin + (phase1:racket-syntax (begin ;; define at phase1 so we can use it (begin-for-syntax (define-literal-set local-literals (literal ...)) diff --git a/collects/honu/core/private/operator.rkt b/collects/honu/core/private/operator.rkt index a9d87cabb4..c568d7a09d 100644 --- a/collects/honu/core/private/operator.rkt +++ b/collects/honu/core/private/operator.rkt @@ -24,13 +24,13 @@ (define-honu-operator/syntax name precedence associativity ;; binary (lambda (left right) - (with-syntax ([left (honu->racket left)] - [right (honu->racket right)]) - (racket-syntax (operator (let () left) (let () right))))) + (with-syntax ([left left] + [right right]) + (racket-syntax (operator left right)))) ;; unary (lambda (argument) (with-syntax ([argument (honu->racket argument)]) - (racket-syntax (operator (let () argument))))))) + (racket-syntax (operator argument)))))) (define-syntax-rule (define-unary-operator name precedence associativity operator) (define-honu-operator/syntax name precedence associativity diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index c72d3ebc45..06be51843c 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -115,18 +115,6 @@ (loop (cons #'name out) #'())] [() (reverse out)]))) -;; removes syntax that causes expression parsing to stop -#; -(define (strip-stops code) - (define-syntax-class stopper #:literal-sets (cruft) - #; - [pattern semicolon] - [pattern honu-comma] - [pattern colon]) - (syntax-parse code - [(x:stopper rest ...) (strip-stops #'(rest ...))] - [else code])) - (define (parse-comma-expression arguments) (if (null? (syntax->list arguments)) '() @@ -137,7 +125,9 @@ (let-values ([(parsed unparsed) ;; FIXME: don't strip all stops, just comma (parse (strip-stops rest))]) - (loop (cons parsed used) + (loop (if parsed + (cons parsed used) + used) unparsed)))))) (define (stopper? what) @@ -160,13 +150,21 @@ #; (honu->racket parsed) #'(void))) - (debug "Output ~a\n" (syntax->datum output)) + (debug "Output ~a unparsed ~a\n" + (syntax->datum output) + (syntax->datum unparsed)) (with-syntax ([output output] [(unparsed-out ...) unparsed] [parse-more parse-more]) (if (null? (syntax->datum #'(unparsed-out ...))) - #'output - #'(begin output (parse-more unparsed-out ...))))] + (if (parsed-syntax? #'output) + #'output + (with-syntax ([(out ...) #'output]) + #'(parse-more out ...))) + (if (parsed-syntax? #'output) + #'(begin output (parse-more unparsed-out ...)) + (with-syntax ([(out ...) #'output]) + #'(parse-more out ... unparsed-out ...)))))] [() #'(begin)])) (define (do-parse-rest/local stx) @@ -205,12 +203,13 @@ (define-syntax-class honu-body #:literal-sets (cruft) [pattern (#%braces code ...) - #:with result (racket-syntax (let () - (define-syntax (parse-more stx) - (syntax-case stx () - [(_ stuff (... ...)) - (do-parse-rest #'(stuff (... ...)) #'parse-more)])) - (parse-more code ...)))]) + #:with result + (racket-syntax (let () + (define-syntax (parse-more stx) + (syntax-case stx () + [(_ stuff (... ...)) + (do-parse-rest #'(stuff (... ...)) #'parse-more)])) + (parse-more code ...)))]) (provide honu-function) (define-splicing-syntax-class honu-function #:literal-sets (cruft) @@ -277,7 +276,9 @@ #; (do-parse #'(parsed ... rest ...) precedence left current) - (define re-parse + (debug "Remove repeats from ~a\n" #'parsed) + (define re-parse #'parsed + #; (with-syntax ([(x ...) #'parsed]) (debug "Properties on parsed ~a\n" (syntax-property-symbol-keys #'parsed)) (do-parse-rest/local #'parsed))) @@ -436,6 +437,7 @@ (debug "Parse a single thing ~a\n" (syntax->datum #'head)) (syntax-parse #'head #:literal-sets (cruft) + #; [(%racket x) (debug 2 "Native racket expression ~a\n" #'x) (if current @@ -445,7 +447,7 @@ (debug 2 "atom ~a current ~a\n" #'x current) (if current (values (left current) stream) - (do-parse #'(rest ...) precedence left #'x))] + (do-parse #'(rest ...) precedence left (racket-syntax x)))] ;; [1, 2, 3] -> (list 1 2 3) [(#%brackets stuff ...) (define-literal-set wheres (honu-where)) @@ -462,21 +464,23 @@ (with-syntax ([((filter ...) ...) filter] [(list.result ...) (map honu->racket (syntax->list #'(list.result ...)))] [work.result (honu->racket #'work.result)]) - #'(for/list ([variable list.result] - ... - filter ... ...) - work.result))) + (racket-syntax (for/list ([variable list.result] + ... + filter ... ...) + work.result)))) (if current (values (left current) stream) (do-parse #'(rest ...) precedence left comprehension))] [else + (debug "Current is ~a\n" current) (define value (with-syntax ([(data ...) (parse-comma-expression #'(stuff ...))]) - #'(list data ...))) + (debug "Create list from ~a\n" #'(data ...)) + (racket-syntax (list data ...)))) (define lookup (with-syntax ([(data ...) (parse-comma-expression #'(stuff ...))] [current current]) - #'(do-lookup current data ...))) + (racket-syntax (do-lookup current data ...)))) (if current ;; (values (left current) stream) (do-parse #'(rest ...) precedence left lookup) @@ -498,7 +502,7 @@ (define call (with-syntax ([current (left current)] [(parsed-args ...) (parse-comma-expression #'(args ...)) ]) - #'(current (let () parsed-args) ...))) + (racket-syntax (current parsed-args ...)))) (do-parse #'(rest ...) 9000 (lambda (x) x) call)) (let () (debug 2 "function call ~a\n" left) @@ -506,7 +510,7 @@ [(parsed-args ...) (parse-comma-expression #'(args ...)) ]) (debug "Parsed args ~a\n" #'(parsed-args ...)) - #'(current (let () parsed-args) ...))) + (racket-syntax (current parsed-args ...)))) (do-parse #'(rest ...) precedence left call))) (let () (debug "inner expression ~a\n" #'(args ...)) @@ -531,7 +535,8 @@ (define-values (parsed unparsed) (do-parse input 0 (lambda (x) x) #f)) - (values (parsed-syntax parsed) + (values ;; (parsed-syntax parsed) + parsed unparsed)) (define (empty-syntax? what) @@ -546,8 +551,15 @@ (define (parse-all code) (let loop ([all '()] [code code]) - (define-values (parsed unparsed) + (define-values (parsed-original unparsed) (parse (strip-stops code))) + (define parsed (if (parsed-syntax? parsed-original) + parsed-original + (let-values ([(out rest) + (parse parsed-original)]) + (when (not (empty-syntax? rest)) + (raise-syntax-error 'parse-all "expected no more syntax" parsed-original)) + out))) (debug "Parsed ~a unparsed ~a\n" (if parsed (syntax->datum parsed) parsed) (if unparsed (syntax->datum unparsed) unparsed)) @@ -556,7 +568,7 @@ (cons parsed all) all))]) (emit-remark "Parsed all" #'(begin use ...)) - #'(begin use ...)) + (racket-syntax (begin use ...))) (loop (cons parsed all) unparsed)))) @@ -590,6 +602,8 @@ #:literal-sets (cruft) [pattern (~seq (~seq each:honu-expression (~optional honu-comma)) ...) #:with (each_result ...) + #'(each.result ...) + #; (with-syntax ([(each ...) (add-between (syntax->list #'(each.result ...)) #'honu-comma)]) #'(each ...)) ]) diff --git a/collects/honu/private/common.rkt b/collects/honu/private/common.rkt index 76edd1f342..d43e313ada 100644 --- a/collects/honu/private/common.rkt +++ b/collects/honu/private/common.rkt @@ -3,6 +3,7 @@ (require honu/core/private/syntax honu/core/private/literals (for-syntax syntax/parse + honu/core/private/debug racket/base honu/core/private/literals honu/core/private/compile @@ -23,10 +24,8 @@ [(_ (~seq clause:honu-expression colon body:honu-expression (~optional honu-comma)) ... . rest) (values - (with-syntax ([(clause.result ...) (map honu->racket (syntax->list #'(clause.result ...)))] - [(body.result ...) (map honu->racket (syntax->list #'(body.result ...)))]) - #'(%racket (cond - [clause.result body.result] - ...))) + (racket-syntax (cond + [clause.result body.result] + ...)) #'rest #t)]))) diff --git a/collects/scribblings/guide/macros.scrbl b/collects/scribblings/guide/macros.scrbl index 8da7bd9ab3..6795b76890 100644 --- a/collects/scribblings/guide/macros.scrbl +++ b/collects/scribblings/guide/macros.scrbl @@ -20,4 +20,5 @@ implemented in Racket---or in a macro-extended variant of Racket. @;------------------------------------------------------------------------ @include-section["pattern-macros.scrbl"] @include-section["proc-macros.scrbl"] +@include-section["phases.scrbl"] diff --git a/collects/scribblings/guide/phases.scrbl b/collects/scribblings/guide/phases.scrbl new file mode 100644 index 0000000000..7b3fefd38f --- /dev/null +++ b/collects/scribblings/guide/phases.scrbl @@ -0,0 +1,374 @@ +#lang scribble/manual + +@title[#:tag "phases"]{Phases} + +@(require scribble/manual scribble/eval) + +@section{Bindings} + +A phase can be thought of as a way to separate computations. Imagine starting +two racket processes. If you ignore socket communication they will not have a +way to share anything. Racket effectively allows multiple invocations to exist +in the same process and phases are the mechanism that keeps them separate, just +like in the multiple process case. Similar to socket communication for processes +phases allow instances of Racket to share information through an explicit +protocol. + +Bindings exist in a phase. The link between a binding and its phase is +represented by an integer called a phase level. Phase level 0 is the phase used +for "plain" definitions, so + +@racketblock[ +(define age 5) +] + +Will put a binding for @racket[age] into phase 0. @racket[age] can be defined at +higher phases levels easily + +@racketblock[ +(begin-for-syntax + (define age 5)) +] + +Now @racket[age] is defined at phase level 1. We can easily mix these two definitions +in the same module, there is no clash between the two @racket[age]'s because +they are defined at different phase levels. + +@(define age-eval (make-base-eval)) +@(interaction-eval #:eval age-eval + (require (for-syntax racket/base))) + +@examples[#:eval age-eval +(define age 3) +(begin-for-syntax + (define age 9)) +] + +@racket[age] at phase level 0 has a value of 3 and @racket[age] at phase level 1 has a value of 9. + +Syntax objects can refer to these bindings. Essentially they capture the binding as a value that can be passed around. + +@racketblock[#'age] + +Is a syntax object that represents the @racket[age] binding. But which +@racket[age] binding? In the last example there are two @racket[age]'s, one at +phase level 0 and one at phase level 1. Racket will imbue @racket[#'age] with lexical +information for all phase levels, so the answer is both! + +Racket knows which @racket[age] to use when the syntax object is used. I'll use eval just for a second to prove a point. + +First we bind @racket[#'age] to a pattern variable so we can use it in a template and then just print it. + +@examples[#:eval age-eval +(eval (with-syntax ([age #'age]) + #'(printf "~a\n" age))) +] + +We get 3 because @racket[age] at phase 0 level is bound to 3. + +@examples[#:eval age-eval +(eval (with-syntax ([age #'age]) + #'(begin-for-syntax + (printf "~a\n" age)))) +] + +We get 9 because we are using @racket[age] at phase level 1 instead of 0. How +does Racket know we wanted to use @racket[age] at phase 1 instead of 0? Because +of the @racket[begin-for-syntax]. @racket[begin-for-syntax] evaluates the +expressions inside it at phase level 1. So you can see that we started with the +same syntax object, @racket[#'age], and was able to use it in two different ways +-- at phase level 0 and at phase level 1. + +When a syntax object is created its lexical context is immediately set up. +Syntax objects provided from a module retain their lexical context and will +reference bindings that existed in the module it came from. + +The following example defines @racket[button] at phase level 0 bound to the +value 0 and @racket[sbutton] which binds the syntax object for @racket[button] +in module @racket[a]. + +@examples[ +(module a racket +(define button 0) +(provide (for-syntax sbutton)) +@code:comment{why not (define sbutton #'button) ? I will explain later} +(define-for-syntax sbutton #'button) +) + +(module b racket +(require 'a) +(define button 8) +(define-syntax (m stx) + sbutton) +(m) +) + +(require 'b) +] + +The result of the @racket[m] macro will be whatever value @racket[sbutton] is +bound to, which is @racket[#'button]. The @racket[#'button] that +@racket[sbutton] knows that @racket[button] is bound from the @racket[a] module +at phase level 0. Even though there is another @racket[button] in @racket[b] +this will not confuse Racket. + +Note that @racket[sbutton] is bound at phase level 1 by virtue of defining it with +@racket[define-for-syntax]. This is needed because @racket[m] is a macro so its +body executes at one phase higher than it was defined at. Since it was defined +at phase level 0 the body will execute at phase level 1, so any bindings in the body also +need to be bound at phase level 1. + +@section{Modules} + +Phases and bindings can get very confusing when used with modules. Racket allows +us to import a module at an arbitrary phase using require. + +@racketblock[ +(require "a.rkt") @code:comment{import at phase 0} +(require (for-syntax "a.rkt")) @code:comment{import at phase 1} +(require (for-template "a.rkt")) @code:comment{import at phase -1} +(require (for-meta 5 "a.rkt" )) @code:comment{import at phase 5} +] + +What does it mean to 'import at phase 1'? Effectively it means that all the +bindings from that module will have their phase increased by one. Similarly when +importing at phase -1 all bindings from that module will have their phase +decreased by one. + +@examples[ +(module c racket + (define x 0) ;; x is defined at phase 0 + (provide x) +) + +(module d racket + (require (for-syntax 'c)) + ) +] + +Now in the @racket[d] module there will be a binding for @racket[x] at phase 1 instead of phase 0. + +So lets look at module @racket[a] from above and see what happens if we try to create a +binding for the @racket[#'button] syntax object at phase 0. + +@(define button-eval (make-base-eval)) +@(interaction-eval #:eval button-eval + (require (for-syntax racket/base))) +@examples[#:eval button-eval +(define button 0) +(define sbutton #'button) +] + +Now both @racket[button] and @racket[sbutton] are defined at phase 0. The lexical +context of @racket[#'button] will know that there is a binding for +@racket[button] at +phase 0. In fact it seems like things are working just fine, if we try to eval +@racket[sbutton] here we will get 0. + +@examples[#:eval button-eval +(eval sbutton) +] + +But now lets use sbutton in a macro. + +@examples[#:eval button-eval +(define-syntax (m stx) + sbutton) +(m) +] + +We get an error 'reference to an identifier before its definition: sbutton'. +Clearly @racket[sbutton] is not defined at phase level 1 so we cannot refer to +it inside the macro. Lets try to use @racket[sbutton] in another module by +putting the button definitions in a module and importing it at phase level 1. +Then we will get @racket[sbutton] at phase level 1. + +@examples[ +(module a racket + (define button 0) + (define sbutton #'button) + (provide sbutton)) + +(module b racket + (require (for-syntax 'a)) ;; now we have sbutton at phase level 1 + (define-syntax (m stx) + sbutton) + (m) +) +] + +Racket says that @racket[button] is unbound now. When @racket[a] is imported at +phase level 1 we have the following bindings + +@verbatim{ +button at phase level 1 +sbutton at phase level 1 +} + +So the macro @racket[m] can see a binding for @racket[sbutton] at phase level 1 +and will return the @racket[#'button] syntax object which refers to +@racket[button] binding at phase 0. But there is no @racket[button] at phase +level 0 in @racket[b], there is only a @racket[button] at phase 1, so we get an +error. That is why @racket[sbutton] needed to be bound at phase 1 in +@racket[a]. In that case we would have had the following bindings after doing +@racket[(require 'a)] + +@verbatim{ +button at phase level 0 +sbutton at phase level 1 +} + +In this scenario we can use @racket[sbutton] in the macro since @racket[sbutton] +is bound at phase level 1 and when the macro finishes it will refer to a +@racket[button] binding at phase level 0. + +However, if we import @racket[a] at phase level 1 we can still manage to use +@racket[sbutton] to get access to @racket[button]. The trick is to create a +syntax object that will be evaluated at phase level 1 instead of 0. We can do +that with @racket[begin-for-syntax]. + +@examples[ +(module a racket +(define button 0) +(define sbutton #'button) +(provide sbutton)) + +(module b racket +(require (for-syntax 'a)) +(define-syntax (m stx) + (with-syntax ([x sbutton]) + #'(begin-for-syntax + (printf "~a\n" x)))) +(m)) +] + +Module @racket[b] has @racket[button] and @racket[sbutton] bound at phase level 1. The output of the macro will be + +@racketblock[ +(begin-for-syntax + (printf "~a\n" button)) + ] + +Because @racket[sbutton] will turn into @racket[button] when the template is expanded. +Now this expression will work because @racket[button] is bound at phase level 1. + +Now you might try to cheat the phase system by importing @racket[a] at both +phase level 0 and phase level 1. Then you would have the following bindings + +@verbatim{ +button at phase level 0 +sbutton at phase level 0 +button at phase level 1 +sbutton at phase level 1 +} + +So just using @racket[sbutton] in a macro should work + +@examples[ +(module a racket + (define button 0) + (define sbutton #'button) + (provide sbutton)) + +(module b racket +(require 'a + (for-syntax 'a)) +(define-syntax (m stx) + sbutton) +(m)) +] + +The @racket[sbutton] inside the @racket[m] macro comes from the +@racket[(for-syntax 'a)]. For this macro to work there must be a @racket[button] +at phase 0 bound, and there is one from the plain @racket[(require 'a)] imported +at phase 0. But in fact this macro doesn't work, it says @racket[button] is +unbound. The key is that @racket[(require 'a)] and @racket[(require (for-syntax +'a))] are different instantiations of the same module. The @racket[sbutton] at +phase 1 only refers to the @racket[button] at phase level 1, not the @racket[button] +bound at phase 0 from a different instantation, even from the same file. + +So this means that if you have a two functions in a module, one that produces a +syntax object and one that matches on it (say using @racket[syntax/parse]) the +module needs to be imported once at the proper phase. The module can't be +imported once at phase 0 and again at phase level 1 and be expected to work. + +@examples[ +(module x racket + +(require (for-syntax syntax/parse) + (for-template racket/base)) + +(provide (all-defined-out)) + +(define button 0) +(define (make) #'button) +(define-syntax (process stx) + (define-literal-set locals (button)) + (syntax-parse stx + [(_ (n (~literal button))) #'#''ok]))) + +(module y racket +(require (for-meta 1 'x) + (for-meta 2 'x racket/base) + ;; (for-meta 2 racket/base) + ) + +(begin-for-syntax + (define-syntax (m stx) + (with-syntax ([out (make)]) + #'(process (0 out))))) + +(define-syntax (p stx) + (m)) + +(p)) +] + +@racket[make] is being used in @racket[y] at phase 2 and returns the +@racket[#'button] syntax object which refers to @racket[button] bound at phase +level 0 inside @racket[x] and at phase 2 in @racket[y] from @racket[(for-meta 2 +'x)]. The @racket[process] macro is imported at phase level 1 from +@racket[(for-meta 1 'x)] and knows that @racket[button] should be bound at phase +level 1 so when the @racket[syntax-parse] is executed inside @racket[process] it +is looking for @racket[button] bound at phase level 1 but it sees a phase level +2 binding and so doesn't match. + +To fix this we can provide @racket[make] at phase level 1 relative to @racket[x] and +just import it at phase level 1 in @racket[y]. + +@examples[ +(module x racket +(require (for-syntax syntax/parse) + (for-template racket/base)) + +(provide (all-defined-out)) + +(define button 0) +(provide (for-syntax make)) +(define-for-syntax (make) #'button) +(define-syntax (process stx) +(define-literal-set locals (button)) + (syntax-parse stx + [(_ (n (~literal button))) #'#''ok]))) + +(module y racket +(require (for-meta 1 'x) + ;; (for-meta 2 'x racket/base) + (for-meta 2 racket/base) + ) + +(begin-for-syntax + (define-syntax (m stx) + (with-syntax ([out (make)]) + #'(process (0 out))))) + +(define-syntax (p stx) + (m)) + +(p)) + +(require 'y) +] + +@(close-eval age-eval) +@(close-eval button-eval) diff --git a/collects/tests/honu/match.honu b/collects/tests/honu/match.honu index f4fc2ce53c..415d17ec06 100644 --- a/collects/tests/honu/match.honu +++ b/collects/tests/honu/match.honu @@ -2,7 +2,7 @@ var => = 0 -pattern match_pattern (){ [element:expression_list]} { [element_each_result ...]} +pattern match_pattern (){ [element:expression_list]} { [ $ element_each_result , $ ...]} pattern match_clause (| =>){ | pattern:match_pattern => out:expression , }