suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[honu] use syntax properties to differentiate parsed syntax from unparsed

Browse Source
This commit is contained in:
Jon Rafkind 2012-03-05 12:32:35 -07:00
parent 89f511fb3e
commit 249c7b02ca
10 changed files with 517 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/honu/core/private/compile.rkt
View File

@ -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])))

12
collects/honu/core/private/honu-typed-scheme.rkt
View File

@ -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 ()

18
collects/honu/core/private/honu2.rkt
View File

@ -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)])))

53
collects/honu/core/private/macro2.rkt
View File

@ -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 ...))

8
collects/honu/core/private/operator.rkt
View File

@ -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

84
collects/honu/core/private/parse2.rkt
View File

@ -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 ...))
])

9
collects/honu/private/common.rkt
View File

@ -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)])))

1
collects/scribblings/guide/macros.scrbl
View File

@ -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"]

374
collects/scribblings/guide/phases.scrbl Normal file
View File

@ -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)

2
collects/tests/honu/match.honu
View File

@ -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 , }