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

generalized `begin-for-syntax'

Browse Source
This commit is contained in:
Matthew Flatt 2011-09-05 16:08:16 -06:00
parent 2f9f780727
commit d3c56c9f13
60 changed files with 2814 additions and 1966 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/compiler/decompile.rkt
View File

@ -164,16 +164,20 @@
(define (decompile-module mod-form stack stx-ht) (define (decompile-module mod-form stack stx-ht)
(match mod-form (match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-body unexported [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported
max-let-depth dummy lang-info internal-context)) max-let-depth dummy lang-info internal-context))
(let-values ([(globs defns) (decompile-prefix prefix stx-ht)] (let-values ([(globs defns) (decompile-prefix prefix stx-ht)]
[(stack) (append '(#%modvars) stack)] [(stack) (append '(#%modvars) stack)]
[(closed) (make-hasheq)]) [(closed) (make-hasheq)])
`(module ,name .... `(module ,name ....
,@defns ,@defns
,@(map (lambda (form) ,@(for/list ([b (in-list syntax-bodies)])
(decompile-form form globs stack closed stx-ht)) (let loop ([n (sub1 (car b))])
syntax-body) (if (zero? n)
(cons 'begin
(for/list ([form (in-list (cdr b))])
(decompile-form form globs stack closed stx-ht)))
(list 'begin-for-syntax (loop (sub1 n))))))
,@(map (lambda (form) ,@(map (lambda (form)
(decompile-form form globs stack closed stx-ht)) (decompile-form form globs stack closed stx-ht))
body)))] body)))]
@ -190,18 +194,19 @@
(list-ref/protect (glob-desc-vars globs) pos 'def-vals)])) (list-ref/protect (glob-desc-vars globs) pos 'def-vals)]))
ids) ids)
,(decompile-expr rhs globs stack closed))] ,(decompile-expr rhs globs stack closed))]
[(struct def-syntaxes (ids rhs prefix max-let-depth)) [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
`(define-syntaxes ,ids `(define-syntaxes ,ids
,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)]) ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
`(let () `(let ()
,@defns ,@defns
,(decompile-form rhs globs '(#%globals) closed stx-ht))))] ,(decompile-form rhs globs '(#%globals) closed stx-ht))))]
[(struct def-for-syntax (ids rhs prefix max-let-depth)) [(struct seq-for-syntax (exprs prefix max-let-depth dummy))
`(define-values-for-syntax ,ids `(begin-for-syntax
,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)]) ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])
`(let () `(let ()
,@defns ,@defns
,(decompile-form rhs globs '(#%globals) closed stx-ht))))] ,@(for/list ([rhs (in-list exprs)])
(decompile-form rhs globs '(#%globals) closed stx-ht)))))]
[(struct seq (forms)) [(struct seq (forms))
`(begin ,@(map (lambda (form) `(begin ,@(map (lambda (form)
(decompile-form form globs stack closed stx-ht)) (decompile-form form globs stack closed stx-ht))

4
collects/compiler/demodularizer/gc-toplevels.rkt
View File

@ -64,7 +64,7 @@
(build-graph! new-lhs rhs)] (build-graph! new-lhs rhs)]
[(? def-syntaxes?) [(? def-syntaxes?)
(error 'build-graph "Doesn't handle syntax")] (error 'build-graph "Doesn't handle syntax")]
[(? def-for-syntax?) [(? seq-for-syntax?)
(error 'build-graph "Doesn't handle syntax")] (error 'build-graph "Doesn't handle syntax")]
[(struct req (reqs dummy)) [(struct req (reqs dummy))
(build-graph! lhs dummy)] (build-graph! lhs dummy)]
@ -197,7 +197,7 @@
#f)] #f)]
[(? def-syntaxes?) [(? def-syntaxes?)
(error 'gc-tls "Doesn't handle syntax")] (error 'gc-tls "Doesn't handle syntax")]
[(? def-for-syntax?) [(? seq-for-syntax?)
(error 'gc-tls "Doesn't handle syntax")] (error 'gc-tls "Doesn't handle syntax")]
[(struct req (reqs dummy)) [(struct req (reqs dummy))
(make-req reqs (update dummy))] (make-req reqs (update dummy))]

3
collects/compiler/demodularizer/merge.rkt
View File

@ -108,7 +108,8 @@
(define (merge-module max-let-depth top-prefix mod-form) (define (merge-module max-let-depth top-prefix mod-form)
(match mod-form (match mod-form
[(struct mod (name srcname self-modidx mod-prefix provides requires body syntax-body unexported mod-max-let-depth dummy lang-info internal-context)) [(struct mod (name srcname self-modidx mod-prefix provides requires body syntax-bodies
unexported mod-max-let-depth dummy lang-info internal-context))
(define toplevel-offset (length (prefix-toplevels top-prefix))) (define toplevel-offset (length (prefix-toplevels top-prefix)))
(define topsyntax-offset (length (prefix-stxs top-prefix))) (define topsyntax-offset (length (prefix-stxs top-prefix)))
(define lift-offset (prefix-num-lifts top-prefix)) (define lift-offset (prefix-num-lifts top-prefix))

5
collects/compiler/demodularizer/nodep.rkt
View File

@ -112,7 +112,8 @@
(define (nodep-module mod-form phase) (define (nodep-module mod-form phase)
(match mod-form (match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-body unexported max-let-depth dummy lang-info internal-context)) [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies
unexported max-let-depth dummy lang-info internal-context))
(define new-prefix prefix) (define new-prefix prefix)
; Cache all the mpi paths ; Cache all the mpi paths
(for-each (match-lambda (for-each (match-lambda
@ -127,7 +128,7 @@
(append (requires->modlist requires phase) (append (requires->modlist requires phase)
(if (and phase (zero? phase)) (if (and phase (zero? phase))
(begin (log-debug (format "[~S] lang-info : ~S" name lang-info)) ; XXX Seems to always be #f now (begin (log-debug (format "[~S] lang-info : ~S" name lang-info)) ; XXX Seems to always be #f now
(list (make-mod name srcname self-modidx new-prefix provides requires body empty (list (make-mod name srcname self-modidx new-prefix provides requires body syntax-bodies empty
unexported max-let-depth dummy lang-info internal-context))) unexported max-let-depth dummy lang-info internal-context)))
(begin (log-debug (format "[~S] Dropping module @ ~S" name phase)) (begin (log-debug (format "[~S] Dropping module @ ~S" name phase))
empty))))] empty))))]

2
collects/compiler/demodularizer/update-toplevels.rkt
View File

@ -10,7 +10,7 @@
(update rhs))] (update rhs))]
[(? def-syntaxes?) [(? def-syntaxes?)
(error 'increment "Doesn't handle syntax")] (error 'increment "Doesn't handle syntax")]
[(? def-for-syntax?) [(? seq-for-syntax?)
(error 'increment "Doesn't handle syntax")] (error 'increment "Doesn't handle syntax")]
[(struct req (reqs dummy)) [(struct req (reqs dummy))
(make-req reqs (update dummy))] (make-req reqs (update dummy))]

103
collects/compiler/zo-marshal.rkt
View File

@ -158,7 +158,7 @@
(define quote-syntax-type-num 14) (define quote-syntax-type-num 14)
(define define-values-type-num 15) (define define-values-type-num 15)
(define define-syntaxes-type-num 16) (define define-syntaxes-type-num 16)
(define define-for-syntax-type-num 17) (define begin-for-syntax-type-num 17)
(define set-bang-type-num 18) (define set-bang-type-num 18)
(define boxenv-type-num 19) (define boxenv-type-num 19)
(define begin0-sequence-type-num 20) (define begin0-sequence-type-num 20)
@ -256,8 +256,6 @@
(define BITS_PER_MZSHORT 32) (define BITS_PER_MZSHORT 32)
(define *dummy* #f)
(define (int->bytes x) (define (int->bytes x)
(integer->integer-bytes x (integer->integer-bytes x
4 4
@ -522,21 +520,20 @@
(out-marshaled define-values-type-num (out-marshaled define-values-type-num
(list->vector (cons (protect-quote rhs) ids)) (list->vector (cons (protect-quote rhs) ids))
out)] out)]
[(struct def-syntaxes (ids rhs prefix max-let-depth)) [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
(out-marshaled define-syntaxes-type-num (out-marshaled define-syntaxes-type-num
(list->vector (list* (protect-quote rhs) (list->vector (list* (protect-quote rhs)
prefix prefix
max-let-depth max-let-depth
*dummy* dummy
ids)) ids))
out)] out)]
[(struct def-for-syntax (ids rhs prefix max-let-depth)) [(struct seq-for-syntax (rhs prefix max-let-depth dummy))
(out-marshaled define-for-syntax-type-num (out-marshaled begin-for-syntax-type-num
(list->vector (list* (protect-quote rhs) (vector (map protect-quote rhs)
prefix prefix
max-let-depth max-let-depth
*dummy* dummy)
ids))
out)] out)]
[(struct beg0 (forms)) [(struct beg0 (forms))
(out-marshaled begin0-sequence-type-num (map protect-quote forms) out)] (out-marshaled begin0-sequence-type-num (map protect-quote forms) out)]
@ -825,7 +822,7 @@
(define (out-module mod-form out) (define (out-module mod-form out)
(match mod-form (match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-body unexported [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported
max-let-depth dummy lang-info internal-context)) max-let-depth dummy lang-info internal-context))
(let* ([lookup-req (lambda (phase) (let* ([lookup-req (lambda (phase)
(let ([a (assq phase requires)]) (let ([a (assq phase requires)])
@ -844,6 +841,11 @@
(if (ormap values p) (if (ormap values p)
(list->vector p) (list->vector p)
#f)))))] #f)))))]
[extract-unexported
(lambda (phase)
(let ([a (assq phase unexported)])
(and a
(cdr a))))]
[list->vector/#f (lambda (default l) [list->vector/#f (lambda (default l)
(if (andmap (lambda (x) (equal? x default)) l) (if (andmap (lambda (x) (equal? x default)) l)
#f #f
@ -861,45 +863,54 @@
[l (cons (lookup-req 1) l)] ; et-requires [l (cons (lookup-req 1) l)] ; et-requires
[l (cons (lookup-req 0) l)] ; requires [l (cons (lookup-req 0) l)] ; requires
[l (cons (list->vector body) l)] [l (cons (list->vector body) l)]
[l (cons (list->vector [l (append (reverse
(for/list ([i (in-list syntax-body)]) (for/list ([b (in-list syntax-bodies)])
(define (maybe-one l) ;; a single symbol is ok (for/vector ([i (in-list (cdr b))])
(if (and (pair? l) (null? (cdr l))) (define (maybe-one l) ;; a single symbol is ok
(car l) (if (and (pair? l) (null? (cdr l)))
l)) (car l)
(match i l))
[(struct def-syntaxes (ids rhs prefix max-let-depth)) (match i
(vector (maybe-one ids) rhs max-let-depth prefix #f)] [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
[(struct def-for-syntax (ids rhs prefix max-let-depth)) (vector (maybe-one ids) rhs max-let-depth prefix #f)]
(vector (maybe-one ids) rhs max-let-depth prefix #t)]))) [(struct seq-for-syntax ((list rhs) prefix max-let-depth dummy))
l)] (vector #f rhs max-let-depth prefix #t)]))))
l)]
[l (append (apply [l (append (apply
append append
(map (lambda (l) (map (lambda (l)
(let ([phase (car l)] (let* ([phase (car l)]
[all (append (cadr l) (caddr l))]) [all (append (cadr l) (caddr l))]
(list phase [protects (extract-protects phase)]
(list->vector/#f 0 (map (lambda (p) (= 1 (provided-src-phase p))) [unexported (extract-unexported phase)])
all)) (append
(list->vector/#f #f (map (lambda (p) (list phase)
(if (eq? (provided-nom-src p) (if (and (not protects)
(provided-src p)) (not unexported))
#f ; #f means "same as src" (list (void))
(provided-nom-src p))) (let ([unexported (or unexported
all)) '(() ()))])
(list->vector (map provided-src-name all)) (list (list->vector (cadr unexported))
(list->vector (map provided-src all)) (length (cadr unexported))
(list->vector (map provided-name all)) (list->vector (car unexported))
(length (cadr l)) (length (car unexported))
(length all)))) protects)))
(list (list->vector/#f 0 (map provided-src-phase all))
(list->vector/#f #f (map (lambda (p)
(if (eq? (provided-nom-src p)
(provided-src p))
#f ; #f means "same as src"
(provided-nom-src p)))
all))
(list->vector (map provided-src-name all))
(list->vector (map provided-src all))
(list->vector (map provided-name all))
(length (cadr l))
(length all)))))
provides)) provides))
l)] l)]
[l (cons (length provides) l)] ; number of provide sets [l (cons (length provides) l)] ; number of provide sets
[l (cons (extract-protects 0) l)] ; protects [l (cons (add1 (length syntax-bodies)) l)]
[l (cons (extract-protects 1) l)] ; et protects
[l (list* (list->vector (car unexported)) (length (car unexported)) l)] ; indirect-provides
[l (list* (list->vector (cadr unexported)) (length (cadr unexported)) l)] ; indirect-syntax-provides
[l (list* (list->vector (caddr unexported)) (length (caddr unexported)) l)] ; indirect-et-provides
[l (cons prefix l)] [l (cons prefix l)]
[l (cons dummy l)] [l (cons dummy l)]
[l (cons max-let-depth l)] [l (cons max-let-depth l)]

159
collects/compiler/zo-parse.rkt
View File

@ -181,19 +181,19 @@
(cdr (vector->list v)) (cdr (vector->list v))
(vector-ref v 0))) (vector-ref v 0)))
; XXX Allocates unnessary list
(define (read-define-syntaxes mk v)
(mk (list-tail (vector->list v) 4)
(vector-ref v 0)
(vector-ref v 1)
(vector-ref v 2)
#;(vector-ref v 3)))
(define (read-define-syntax v) (define (read-define-syntax v)
(read-define-syntaxes make-def-syntaxes v)) (make-def-syntaxes (list-tail (vector->list v) 4)
(vector-ref v 0)
(vector-ref v 1)
(vector-ref v 2)
(vector-ref v 3)))
(define (read-define-for-syntax v) (define (read-begin-for-syntax v)
(read-define-syntaxes make-def-for-syntax v)) (make-seq-for-syntax
(vector-ref v 0)
(vector-ref v 1)
(vector-ref v 2)
(vector-ref v 3)))
(define (read-set! v) (define (read-set! v)
(make-assign (cadr v) (cddr v) (car v))) (make-assign (cadr v) (cddr v) (car v)))
@ -225,50 +225,65 @@
(lambda _ #t) (lambda _ #t)
(lambda _ #t))))) (lambda _ #t)))))
(define (split-phase-data rest n)
(let loop ([n n] [rest rest] [phase-accum null])
(cond
[(zero? n)
(values (reverse phase-accum) rest)]
[else
(let ([maybe-indirect (list-ref rest 1)])
(if (void? maybe-indirect)
;; no indirect or protect info:
(loop (sub1 n)
(list-tail rest 9)
(cons (take rest 9) phase-accum))
;; has indirect or protect info:
(loop (sub1 n)
(list-tail rest (+ 5 8))
(cons (take rest (+ 5 8)) phase-accum))))])))
(define (read-module v) (define (read-module v)
(match v (match v
[`(,name ,srcname ,self-modidx ,lang-info ,functional? ,et-functional? [`(,name ,srcname ,self-modidx ,lang-info ,functional? ,et-functional?
,rename ,max-let-depth ,dummy ,rename ,max-let-depth ,dummy
,prefix ,prefix ,num-phases
,indirect-et-provides ,num-indirect-et-provides
,indirect-syntax-provides ,num-indirect-syntax-provides
,indirect-provides ,num-indirect-provides
,protects ,et-protects
,provide-phase-count . ,rest) ,provide-phase-count . ,rest)
(let ([phase-data (take rest (* 8 provide-phase-count))]) (let*-values ([(phase-data rest-module) (split-phase-data rest provide-phase-count)]
(match (list-tail rest (* 8 provide-phase-count)) [(bodies rest-module) (values (take rest-module num-phases)
[`(,syntax-body ,body (drop rest-module num-phases))])
,requires ,syntax-requires ,template-requires ,label-requires (match rest-module
,more-requires-count . ,more-requires) [`(,requires ,syntax-requires ,template-requires ,label-requires
,more-requires-count . ,more-requires)
(make-mod name srcname self-modidx (make-mod name srcname self-modidx
prefix (let loop ([l phase-data]) prefix
(if (null? l) ;; provides:
null (for/list ([l (in-list phase-data)])
(let ([num-vars (list-ref l 6)] (let* ([phase (list-ref l 0)]
[ps (for/list ([name (in-vector (list-ref l 5))] [has-info? (not (void? (list-ref l 1)))]
[src (in-vector (list-ref l 4))] [delta (if has-info? 5 1)]
[src-name (in-vector (list-ref l 3))] [num-vars (list-ref l (+ delta 6))]
[nom-src (or (list-ref l 2) [num-all (list-ref l (+ delta 7))]
(in-cycle (in-value #f)))] [ps (for/list ([name (in-vector (list-ref l (+ delta 5)))]
[src-phase (or (list-ref l 1) [src (in-vector (list-ref l (+ delta 4)))]
(in-cycle (in-value #f)))] [src-name (in-vector (list-ref l (+ delta 3)))]
[protected? (or (case (car l) [nom-src (or (list-ref l (+ delta 2))
[(0) protects] (in-cycle (in-value #f)))]
[(1) et-protects] [src-phase (or (list-ref l (+ delta 1))
[else #f]) (in-cycle (in-value 0)))]
(in-cycle (in-value #f)))]) [protected? (cond
(make-provided name src src-name [(or (not has-info?)
(or nom-src src) (not (list-ref l 5)))
(if src-phase 1 0) (in-cycle (in-value #f))]
protected?))]) [else (list-ref l 5)])])
(if (null? ps) (make-provided name src src-name
(loop (list-tail l 8)) (or nom-src src)
(cons src-phase
(list protected?))])
(car l) (list
(take ps num-vars) phase
(drop ps num-vars)) (take ps num-vars)
(loop (list-tail l 8))))))) (drop ps num-vars))))
;; requires:
(list* (list*
(cons 0 requires) (cons 0 requires)
(cons 1 syntax-requires) (cons 1 syntax-requires)
@ -276,20 +291,34 @@
(cons #f label-requires) (cons #f label-requires)
(for/list ([(phase reqs) (in-list* more-requires 2)]) (for/list ([(phase reqs) (in-list* more-requires 2)])
(cons phase reqs))) (cons phase reqs)))
(vector->list body) ;; body:
(map (lambda (sb) (vector->list (last bodies))
(match sb ;; syntax-bodies: add phase to each list, break apart
[(? def-syntaxes?) sb] (for/list ([b (cdr (reverse bodies))]
[(? def-for-syntax?) sb] [i (in-naturals 1)])
[`#(,ids ,expr ,max-let-depth ,prefix ,for-stx?) (cons i
((if for-stx? (for/list ([sb (in-vector b)])
make-def-for-syntax (match sb
make-def-syntaxes) [`#(,ids ,expr ,max-let-depth ,prefix ,for-stx?)
(if (list? ids) ids (list ids)) expr prefix max-let-depth)])) (if for-stx?
(vector->list syntax-body)) (make-seq-for-syntax (list expr) prefix max-let-depth #f)
(list (vector->list indirect-provides) (make-def-syntaxes
(vector->list indirect-syntax-provides) (if (list? ids) ids (list ids)) expr prefix max-let-depth #f))]
(vector->list indirect-et-provides)) [else (error 'zo-parse "bad phase ~a body element: ~e" i sb)]))))
;; unexported:
(for/list ([l (in-list phase-data)]
#:when (not (void? (list-ref l 1))))
(let* ([phase (list-ref l 0)]
[indirect-syntax
;; could check: (list-ref l 2) should be size of vector:
(list-ref l 1)]
[indirect
;; could check: (list-ref l 4) should be size of vector:
(list-ref l 3)])
(list
phase
(vector->list indirect)
(vector->list indirect-syntax))))
max-let-depth max-let-depth
dummy dummy
lang-info lang-info
@ -313,7 +342,7 @@
[(14) 'quote-syntax-type] [(14) 'quote-syntax-type]
[(15) 'define-values-type] [(15) 'define-values-type]
[(16) 'define-syntaxes-type] [(16) 'define-syntaxes-type]
[(17) 'define-for-syntax-type] [(17) 'begin-for-syntax-type]
[(18) 'set-bang-type] [(18) 'set-bang-type]
[(19) 'boxenv-type] [(19) 'boxenv-type]
[(20) 'begin0-sequence-type] [(20) 'begin0-sequence-type]
@ -350,7 +379,7 @@
(cons 'free-id-info-type read-free-id-info) (cons 'free-id-info-type read-free-id-info)
(cons 'define-values-type read-define-values) (cons 'define-values-type read-define-values)
(cons 'define-syntaxes-type read-define-syntax) (cons 'define-syntaxes-type read-define-syntax)
(cons 'define-for-syntax-type read-define-for-syntax) (cons 'begin-for-syntax-type read-begin-for-syntax)
(cons 'set-bang-type read-set!) (cons 'set-bang-type read-set!)
(cons 'boxenv-type read-boxenv) (cons 'boxenv-type read-boxenv)
(cons 'require-form-type read-require) (cons 'require-form-type read-require)

27
collects/compiler/zo-structs.rkt
View File

@ -80,7 +80,7 @@
[src (or/c module-path-index? #f)] [src (or/c module-path-index? #f)]
[src-name symbol?] [src-name symbol?]
[nom-src any/c] ; should be (or/c module-path-index? #f) [nom-src any/c] ; should be (or/c module-path-index? #f)
[src-phase (or/c 0 1)] [src-phase exact-nonnegative-integer?]
[protected? boolean?])) [protected? boolean?]))
(define-form-struct (toplevel expr) ([depth exact-nonnegative-integer?] (define-form-struct (toplevel expr) ([depth exact-nonnegative-integer?]
@ -89,18 +89,19 @@
[ready? boolean?])) ; access binding via prefix array (which is on stack) [ready? boolean?])) ; access binding via prefix array (which is on stack)
(define-form-struct (seq form) ([forms (listof (or/c form? any/c))])) ; `begin' (define-form-struct (seq form) ([forms (listof (or/c form? any/c))])) ; `begin'
(define-form-struct (seq-for-syntax form) ([forms (listof (or/c form? any/c))] ; `begin-for-syntax'
[prefix prefix?]
[max-let-depth exact-nonnegative-integer?]
[dummy (or/c toplevel? #f)]))
;; Definitions (top level or within module): ;; Definitions (top level or within module):
(define-form-struct (def-values form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol? (define-form-struct (def-values form) ([ids (listof (or/c toplevel? symbol?))]
[rhs (or/c expr? seq? any/c)])) [rhs (or/c expr? seq? any/c)]))
(define-form-struct (def-syntaxes form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol? (define-form-struct (def-syntaxes form) ([ids (listof (or/c toplevel? symbol?))]
[rhs (or/c expr? seq? any/c)] [rhs (or/c expr? seq? any/c)]
[prefix prefix?] [prefix prefix?]
[max-let-depth exact-nonnegative-integer?])) [max-let-depth exact-nonnegative-integer?]
(define-form-struct (def-for-syntax form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol? [dummy (or/c toplevel? #f)]))
[rhs (or/c expr? seq? any/c)]
[prefix prefix?]
[max-let-depth exact-nonnegative-integer?]))
(define-form-struct (mod form) ([name symbol?] (define-form-struct (mod form) ([name symbol?]
[srcname symbol?] [srcname symbol?]
@ -111,10 +112,12 @@
(listof provided?)))] (listof provided?)))]
[requires (listof (cons/c (or/c exact-integer? #f) [requires (listof (cons/c (or/c exact-integer? #f)
(listof module-path-index?)))] (listof module-path-index?)))]
[body (listof (or/c form? any/c))] [body (listof (or/c form? any/c))]
[syntax-body (listof (or/c def-syntaxes? def-for-syntax?))] [syntax-bodies (listof (cons/c exact-positive-integer?
[unexported (list/c (listof symbol?) (listof symbol?) (listof (or/c def-syntaxes? seq-for-syntax?))))]
(listof symbol?))] [unexported (listof (list/c exact-nonnegative-integer?
(listof symbol?)
(listof symbol?)))]
[max-let-depth exact-nonnegative-integer?] [max-let-depth exact-nonnegative-integer?]
[dummy toplevel?] [dummy toplevel?]
[lang-info (or/c #f (vector/c module-path? symbol? any/c))] [lang-info (or/c #f (vector/c module-path? symbol? any/c))]

4
collects/deinprogramm/signature/module-begin.rkt
View File

@ -174,7 +174,7 @@
;; Lift out certain forms to make them visible to the module ;; Lift out certain forms to make them visible to the module
;; expander: ;; expander:
(syntax-case e2 (#%require #%provide (syntax-case e2 (#%require #%provide
define-syntaxes define-values-for-syntax define-values begin define-syntaxes begin-for-syntax define-values begin
define-record-procedures define-record-procedures-2 define-record-procedures define-record-procedures-2
define-record-procedures-parametric define-record-procedures-parametric-2 define-record-procedures-parametric define-record-procedures-parametric-2
define-contract :) define-contract :)
@ -184,7 +184,7 @@
#`(begin #,e2 (frm e3s #,e1s #,def-ids))) #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
((define-syntaxes (id ...) . _) ((define-syntaxes (id ...) . _)
#`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids)))) #`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids))))
((define-values-for-syntax . _) ((begin-for-syntax . _)
#`(begin #,e2 (frm e3s #,e1s #,def-ids))) #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
((begin b1 ...) ((begin b1 ...)
(syntax-track-origin (syntax-track-origin

2
collects/drracket/private/syncheck/contract-traversal.rkt
View File

@ -109,7 +109,7 @@
(call-give-up)] (call-give-up)]
[(define-syntaxes (id ...) expr) [(define-syntaxes (id ...) expr)
(call-give-up)] (call-give-up)]
[(define-values-for-syntax (id ...) expr) [(begin-for-syntax (id ...) expr)
(call-give-up)] (call-give-up)]
[(#%require rspec ...) [(#%require rspec ...)
(call-give-up)] (call-give-up)]

18
collects/errortrace/stacktrace.rkt
View File

@ -377,17 +377,15 @@
expr expr
(rebuild disarmed-expr (list (cons #'rhs marked)))))] (rebuild disarmed-expr (list (cons #'rhs marked)))))]
[(define-values-for-syntax (name ...) rhs) [(begin-for-syntax . exprs)
top? top?
(let ([marked (with-mark expr (rearm
(annotate-named expr
(one-name (syntax (name ...))) (annotate-seq disarmed-expr
(syntax rhs) (syntax exprs)
(add1 phase)))]) annotate-top
(rearm (add1 phase)))]
expr
(rebuild disarmed-expr (list (cons #'rhs marked)))))]
[(module name init-import mb) [(module name init-import mb)
(syntax-case (disarm #'mb) () (syntax-case (disarm #'mb) ()
[(__plain-module-begin body ...) [(__plain-module-begin body ...)

5
collects/gui-debugger/annotator.rkt
View File

@ -203,9 +203,8 @@
] ]
[(define-syntaxes (var ...) expr) [(define-syntaxes (var ...) expr)
stx] stx]
[(define-values-for-syntax (var ...) expr) [(begin-for-syntax . exprs)
;; define-values-for-syntax's RHS is compile time, so treat it ;; compile time, so treat it like define-syntaxes
;; like define-syntaxes
stx] stx]
[(begin . top-level-exprs) [(begin . top-level-exprs)
(quasisyntax/loc stx (begin #,@(map (lambda (expr) (quasisyntax/loc stx (begin #,@(map (lambda (expr)

4
collects/lang/private/teach-module-begin.rkt
View File

@ -180,7 +180,7 @@
;; Lift out certain forms to make them visible to the module ;; Lift out certain forms to make them visible to the module
;; expander: ;; expander:
(syntax-case e2 (#%require #%provide (syntax-case e2 (#%require #%provide
define-syntaxes define-values-for-syntax define-values begin define-syntaxes begin-for-syntax define-values begin
define-signature :) define-signature :)
((#%require . __) ((#%require . __)
#`(begin #,e2 (frm e3s #,e1s #,def-ids))) #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
@ -188,7 +188,7 @@
#`(begin #,e2 (frm e3s #,e1s #,def-ids))) #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
((define-syntaxes (id ...) . _) ((define-syntaxes (id ...) . _)
#`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids)))) #`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids))))
((define-values-for-syntax . _) ((begin-for-syntax . _)
#`(begin #,e2 (frm e3s #,e1s #,def-ids))) #`(begin #,e2 (frm e3s #,e1s #,def-ids)))
((begin b1 ...) ((begin b1 ...)
(syntax-track-origin (syntax-track-origin

2
collects/macro-debugger/model/trace.rkt
View File

@ -152,7 +152,7 @@
(eval/compile stx)] (eval/compile stx)]
[(define-syntaxes . _) [(define-syntaxes . _)
(eval/compile stx)] (eval/compile stx)]
[(define-values-for-syntax . _) [(begin-for-syntax . _)
(eval/compile stx)] (eval/compile stx)]
[(define-values (id ...) . _) [(define-values (id ...) . _)
(with-syntax ([defvals (stx-car stx)] (with-syntax ([defvals (stx-car stx)]

5
collects/mzlib/include.rkt
View File

@ -20,7 +20,10 @@
fn)) fn))
(string->path s))] (string->path s))]
[(-build-path elem ...) [(-build-path elem ...)
(module-or-top-identifier=? #'-build-path build-path-stx) (begin
(collect-garbage)
(module-identifier=? #'-build-path build-path-stx)
(module-or-top-identifier=? #'-build-path build-path-stx))
(let ([l (syntax-object->datum (syntax (elem ...)))]) (let ([l (syntax-object->datum (syntax (elem ...)))])
(when (null? l) (when (null? l)
(raise-syntax-error (raise-syntax-error

7
collects/r6rs/main.rkt
View File

@ -161,7 +161,7 @@ FIXME:
(free-identifier=? id #'def))) (free-identifier=? id #'def)))
(list #'define-values (list #'define-values
#'define-syntaxes #'define-syntaxes
#'define-values-for-syntax)) #'begin-for-syntax))
#`(begin #,a (library-body/defns . more))] #`(begin #,a (library-body/defns . more))]
[(#%require . _) [(#%require . _)
;; We allow `require' mixed with definitions, because it ;; We allow `require' mixed with definitions, because it
@ -268,9 +268,8 @@ FIXME:
(hash-set! table (hash-set! table
(syntax-e id) (syntax-e id)
(cons (cons id phase) l))))))]) (cons (cons id phase) l))))))])
(let-values ([(ids for-syntax-ids) (syntax-local-module-defined-identifiers)]) (for ([(phase ids) (in-hash (syntax-local-module-defined-identifiers))])
(for-each (map-id 0) ids) (for-each (map-id phase) ids))
(for-each (map-id 1) for-syntax-ids))
(for-each (lambda (l) (for-each (lambda (l)
(if (car l) (if (car l)
(for-each (map-id (car l)) (cdr l)) (for-each (map-id (car l)) (cdr l))

79
collects/racket/private/define.rkt
View File

@ -7,7 +7,22 @@
"letstx-scheme.rkt" "stxcase-scheme.rkt" "stx.rkt" "qqstx.rkt" "letstx-scheme.rkt" "stxcase-scheme.rkt" "stx.rkt" "qqstx.rkt"
"norm-define.rkt")) "norm-define.rkt"))
(#%provide define define-syntax define-for-syntax begin-for-syntax) (#%provide define
define-syntax
define-values-for-syntax
define-for-syntax)
(define-syntaxes (define-values-for-syntax)
(lambda (stx)
(syntax-case stx ()
[(_ (id ...) expr)
(begin
(for-each (lambda (x)
(unless (identifier? x)
(raise-syntax-error #f "not an identifier" x stx)))
(syntax->list #'(id ...)))
#'(begin-for-syntax
(define-values (id ...) expr)))])))
(define-syntaxes (define define-syntax define-for-syntax) (define-syntaxes (define define-syntax define-for-syntax)
(let ([go (let ([go
@ -18,64 +33,4 @@
(#,define-values-stx (#,id) #,rhs))))]) (#,define-values-stx (#,id) #,rhs))))])
(values (lambda (stx) (go #'define-values stx)) (values (lambda (stx) (go #'define-values stx))
(lambda (stx) (go #'define-syntaxes stx)) (lambda (stx) (go #'define-syntaxes stx))
(lambda (stx) (go #'define-values-for-syntax stx))))) (lambda (stx) (go #'define-values-for-syntax stx))))))
(define-syntaxes (begin-for-syntax)
(lambda (stx)
(let ([ctx (syntax-local-context)])
(unless (memq ctx '(module module-begin top-level))
(raise-syntax-error #f "allowed only at the top-level or a module top-level" stx))
(syntax-case stx ()
[(_) #'(begin)]
[(_ elem)
(not (eq? ctx 'module-begin))
(let ([e (local-transformer-expand/capture-lifts
#'elem
ctx
(syntax->list
#'(begin
define-values
define-syntaxes
define-values-for-syntax
set!
let-values
let*-values
letrec-values
lambda
case-lambda
if
quote
letrec-syntaxes+values
fluid-let-syntax
with-continuation-mark
#%expression
#%variable-reference
#%app
#%top
#%provide
#%require)))])
(syntax-case* e (begin define-values define-syntaxes require require-for-template)
free-transformer-identifier=?
[(begin (begin v ...))
#'(begin-for-syntax v ...)]
[(begin (define-values (id ...) expr))
#'(define-values-for-syntax (id ...) expr)]
[(begin (require v ...))
#'(require (for-syntax v ...))]
[(begin (define-syntaxes (id ...) expr))
(raise-syntax-error
#f
"syntax definitions not allowed within begin-for-syntax"
#'elem)]
[(begin other)
#'(define-values-for-syntax () (begin other (values)))]
[(begin v ...)
#'(begin-for-syntax v ...)]))]
[(_ elem ...)
;; We split up the elems so that someone else can
;; worry about the fact that properly expanding the second
;; things might depend somehow on the first thing.
;; This also avoids a problem when `begin-for-syntax' is the
;; only thing in a module body, and `module' has to expand
;; it looking for #%module-begin.
(syntax/loc stx (begin (begin-for-syntax elem) ...))])))))

4
collects/racket/private/modbeg.rkt
View File

@ -61,7 +61,7 @@
begin begin0 set! begin begin0 set!
with-continuation-mark with-continuation-mark
if #%app #%expression if #%app #%expression
define-values define-syntaxes define-values-for-syntax define-values define-syntaxes begin-for-syntax
module module
#%module-begin #%module-begin
#%require #%provide #%require #%provide
@ -98,7 +98,7 @@
(free-identifier=? i a)) (free-identifier=? i a))
(syntax->list (syntax->list
(quote-syntax (quote-syntax
(define-values define-syntaxes define-values-for-syntax (define-values define-syntaxes begin-for-syntax
module module
#%module-begin #%module-begin
#%require #%provide)))) #%require #%provide))))

45
collects/racket/private/old-rp.rkt
View File

@ -5,28 +5,29 @@
(#%provide require require-for-syntax require-for-template require-for-label (#%provide require require-for-syntax require-for-template require-for-label
provide provide-for-syntax provide-for-label) provide provide-for-syntax provide-for-label)
(define-values-for-syntax (rebuild-elem) (begin-for-syntax
(lambda (stx elem sub pos loop ids) (define-values (rebuild-elem)
;; For sub-forms, we loop and reconstruct: (lambda (stx elem sub pos loop ids)
(for-each (lambda (id) ;; For sub-forms, we loop and reconstruct:
(unless (identifier? id) (for-each (lambda (id)
(raise-syntax-error (unless (identifier? id)
#f (raise-syntax-error
"expected an identifier" #f
stx "expected an identifier"
id))) stx
(syntax->list ids)) id)))
(let rloop ([elem elem][pos pos]) (syntax->list ids))
(if (syntax? elem) (let rloop ([elem elem][pos pos])
(datum->syntax elem (if (syntax? elem)
(rloop (syntax-e elem) pos) (datum->syntax elem
elem (rloop (syntax-e elem) pos)
elem) elem
(if (zero? pos) elem)
(cons (loop (car elem)) (if (zero? pos)
(cdr elem)) (cons (loop (car elem))
(cons (car elem) (cdr elem))
(rloop (cdr elem) (sub1 pos)))))))) (cons (car elem)
(rloop (cdr elem) (sub1 pos)))))))))
(define-syntaxes (require require-for-syntax require-for-template require-for-label) (define-syntaxes (require require-for-syntax require-for-template require-for-label)

76
collects/racket/private/reqprov.rkt
View File

@ -636,36 +636,41 @@
(lambda (stx modes) (lambda (stx modes)
(syntax-case stx () (syntax-case stx ()
[(_) [(_)
(let-values ([(ids stx-ids) (syntax-local-module-defined-identifiers)] (let* ([ht (syntax-local-module-defined-identifiers)]
[(same-ctx?) (lambda (free-identifier=?) [same-ctx? (lambda (free-identifier=?)
(lambda (id) (lambda (id)
(free-identifier=? id (free-identifier=? id
(datum->syntax (datum->syntax
stx stx
(syntax-e id)))))]) (syntax-e id)))))]
(append [modes (if (null? modes)
(if (memq 1 modes) '(0)
(map (lambda (id) modes)])
(make-export id (syntax-e id) 1 #f stx)) (apply
(filter (same-ctx? free-transformer-identifier=?) append
stx-ids)) (map (lambda (mode)
null) (let* ([phase (and mode (+ mode (syntax-local-phase-level)))]
(if (or (null? modes) [same-ctx-in-phase?
(memq 0 modes)) (same-ctx?
(map (lambda (id) (cond
(make-export id (syntax-e id) 0 #f stx)) [(eq? mode 0) free-identifier=?]
(filter (lambda (id) [(eq? mode 1) free-transformer-identifier=?]
(and ((same-ctx? free-identifier=?) id) [else (lambda (a b)
(let-values ([(v id) (syntax-local-value/immediate (free-identifier=? a b phase))]))])
id (map (lambda (id)
(lambda () (values #f #f)))]) (make-export id (syntax-e id) mode #f stx))
(not (filter (lambda (id)
(and (rename-transformer? v) (and (same-ctx-in-phase? id)
(syntax-property (let-values ([(v id) (syntax-local-value/immediate
(rename-transformer-target v) id
'not-provide-all-defined)))))) (lambda () (values #f #f)))])
ids)) (not
null)))])))) (and (rename-transformer? v)
(syntax-property
(rename-transformer-target v)
'not-provide-all-defined))))))
(hash-ref ht phase null)))))
modes)))]))))
(define-syntax all-from-out (define-syntax all-from-out
(make-provide-transformer (make-provide-transformer
@ -815,7 +820,7 @@
(equal? '(0) modes)) (equal? '(0) modes))
(raise-syntax-error (raise-syntax-error
#f #f
"allowed only for phase level 0" "allowed only for relative phase level 0"
stx)) stx))
(syntax-case stx () (syntax-case stx ()
[(_ id) [(_ id)
@ -848,13 +853,14 @@
null] null]
[else (cons (car ids) (loop (cdr ids)))]))))] [else (cons (car ids) (loop (cdr ids)))]))))]
;; FIXME: we're building a list of all imports on every expansion ;; FIXME: we're building a list of all imports on every expansion
;; of `syntax-out'. That could become expensive if `syntax-out' is ;; of `struct-out'. That could become expensive if `struct-out' is
;; used a lot. ;; used a lot.
[avail-ids (append (let-values ([(ids _) (syntax-local-module-defined-identifiers)]) [avail-ids (append (hash-ref (syntax-local-module-defined-identifiers)
ids) (syntax-local-phase-level)
null)
(let ([idss (syntax-local-module-required-identifiers #f #t)]) (let ([idss (syntax-local-module-required-identifiers #f #t)])
(if idss (if idss
(let ([a (assoc 0 idss)]) (let ([a (assoc (syntax-local-phase-level) idss)])
(if a (if a
(cdr a) (cdr a)
null)) null))

21
collects/racket/private/stxcase-scheme.rkt
View File

@ -25,16 +25,17 @@
names) names)
#f))) #f)))
(define-values-for-syntax (check-sr-rules) (begin-for-syntax
(lambda (stx kws) (define-values (check-sr-rules)
(for-each (lambda (id) (lambda (stx kws)
(unless (identifier? id) (for-each (lambda (id)
(raise-syntax-error (unless (identifier? id)
#f (raise-syntax-error
"pattern must start with an identifier, found something else" #f
stx "pattern must start with an identifier, found something else"
id))) stx
(syntax->list kws)))) id)))
(syntax->list kws)))))
;; From Dybvig, mostly: ;; From Dybvig, mostly:
(-define-syntax syntax-rules (-define-syntax syntax-rules

2
collects/scribble/doclang.rkt
View File

@ -54,7 +54,7 @@
provide provide
define-values define-values
define-syntaxes define-syntaxes
define-values-for-syntax begin-for-syntax
#%require #%require
#%provide)))) #%provide))))
#`(begin #,expanded (doc-begin m-id post-process exprs . body))] #`(begin #,expanded (doc-begin m-id post-process exprs . body))]

1
collects/scribble/private/lp.rkt
View File

@ -50,7 +50,6 @@
[(rest ...) (if n [(rest ...) (if n
#`((subscript #,(format "~a" n))) #`((subscript #,(format "~a" n)))
#`())]) #`())])
#`(begin #`(begin
(require (for-label for-label-mod ... ...)) (require (for-label for-label-mod ... ...))
#,@(if n #,@(if n

2
collects/scribble/text/syntax-utils.rkt
View File

@ -7,7 +7,7 @@
(begin-for-syntax (begin-for-syntax
(define definition-ids ; ids that don't require forcing (define definition-ids ; ids that don't require forcing
(syntax->list #'(define-values define-syntaxes define-values-for-syntax (syntax->list #'(define-values define-syntaxes begin-for-syntax
require provide #%require #%provide))) require provide #%require #%provide)))
(define stoplist (append definition-ids (kernel-form-identifier-list))) (define stoplist (append definition-ids (kernel-form-identifier-list)))
(define (definition-id? id) (define (definition-id? id)

22
collects/scribblings/guide/proc-macros.scrbl
View File

@ -352,19 +352,20 @@ make all of these modes treat code consistently, Racket separates the
binding spaces for different phases. binding spaces for different phases.
To define a @racket[check-ids] function that can be referenced at To define a @racket[check-ids] function that can be referenced at
compile time, use @racket[define-for-syntax]: compile time, use @racket[begin-for-syntax]:
@racketblock/eval[ @racketblock/eval[
#:eval check-eval #:eval check-eval
(define-for-syntax (check-ids stx forms) (begin-for-syntax
(for-each (define (check-ids stx forms)
(lambda (form) (for-each
(unless (identifier? form) (lambda (form)
(raise-syntax-error #f (unless (identifier? form)
"not an identifier" (raise-syntax-error #f
stx "not an identifier"
form))) stx
(syntax->list forms))) form)))
(syntax->list forms))))
] ]
With this for-syntax definition, then @racket[swap] works: With this for-syntax definition, then @racket[swap] works:
@ -446,6 +447,7 @@ the right-hand side of the inner @racket[define-syntax] is in the
2}. To import @racket[syntax-case] into that phase level, you would 2}. To import @racket[syntax-case] into that phase level, you would
have to use @racket[(require (for-syntax (for-syntax racket/base)))] have to use @racket[(require (for-syntax (for-syntax racket/base)))]
or, equivalently, @racket[(require (for-meta 2 racket/base))]. For example, or, equivalently, @racket[(require (for-meta 2 racket/base))]. For example,
@codeblock|{ @codeblock|{
#lang racket/base #lang racket/base
(require ;; This provides the bindings for the definition (require ;; This provides the bindings for the definition

62
collects/scribblings/raco/zo-struct.scrbl
View File

@ -106,26 +106,28 @@ structures that are produced by @racket[zo-parse] and consumed by
@defstruct+[(def-syntaxes form) ([ids (listof symbol?)] @defstruct+[(def-syntaxes form) ([ids (listof symbol?)]
[rhs (or/c expr? seq? any/c)] [rhs (or/c expr? seq? any/c)]
[prefix prefix?] [prefix prefix?]
[max-let-depth exact-nonnegative-integer?])] [max-let-depth exact-nonnegative-integer?]
@defstruct+[(def-for-syntax form) [dummy (or/c toplevel? #f)])]
([ids (listof toplevel?)] @defstruct+[(seq-for-syntax form)
[rhs (or/c expr? seq? any/c)] ([forms (listof (or/c form? any/c))]
[prefix prefix?] [prefix prefix?]
[max-let-depth exact-nonnegative-integer?])] [max-let-depth exact-nonnegative-integer?]
[dummy (or/c toplevel? #f)])]
)]{ )]{
Represents a @racket[define-syntaxes] or Represents a @racket[define-syntaxes] or
@racket[define-values-for-syntax] form. The @racket[rhs] expression @racket[begin-for-syntax] form. The @racket[rhs] expression or set of
has its own @racket[prefix], which is pushed before evaluating @racket[forms] forms has its own @racket[prefix], which is pushed before evaluating
@racket[rhs]; the stack is restored after obtaining the result values. @racket[rhs] or the @racket[forms]; the stack is restored after obtaining the result values.
The @racket[max-let-depth] field indicates the maximum size of the The @racket[max-let-depth] field indicates the maximum size of the
stack that will be created by @racket[rhs] (not counting stack that will be created by @racket[rhs] (not counting
@racket[prefix]).} @racket[prefix]). The @racket[dummy] variable is used to access the enclosing
namespace.}
@defstruct+[(req form) ([reqs stx?] @defstruct+[(req form) ([reqs stx?]
[dummy toplevel?])]{ [dummy toplevel?])]{
Represents a top-level @racket[#%require] form (but not one in a Represents a top-level @racket[#%require] form (but not one in a
@racket[module] form) with a sequence of specifications @racket[reqs]. @racket[module] form) with a sequence of specifications @racket[reqs].
The @racket[dummy] variable is used to access to the top-level The @racket[dummy] variable is used to access the top-level
namespace.} namespace.}
@defstruct+[(seq form) ([forms (listof (or/c form? any/c))])]{ @defstruct+[(seq form) ([forms (listof (or/c form? any/c))])]{
@ -155,17 +157,17 @@ structures that are produced by @racket[zo-parse] and consumed by
[requires (listof (cons/c (or/c exact-integer? #f) [requires (listof (cons/c (or/c exact-integer? #f)
(listof module-path-index?)))] (listof module-path-index?)))]
[body (listof (or/c form? any/c))] [body (listof (or/c form? any/c))]
[syntax-body (listof (or/c def-syntaxes? def-for-syntax?))] [syntax-bodies (listof (cons/c exact-positive-integer?
[unexported (list/c (listof symbol?) (listof (or/c def-syntaxes?
(listof symbol?) seq-for-syntax?))))]
(listof symbol?))] [unexported (listof (list/c exact-nonnegative-integer?
(listof symbol?)
(listof symbol?)))]
[max-let-depth exact-nonnegative-integer?] [max-let-depth exact-nonnegative-integer?]
[dummy toplevel?] [dummy toplevel?]
[lang-info (or/c #f (vector/c module-path? symbol? any/c))] [lang-info (or/c #f (vector/c module-path? symbol? any/c))]
[internal-context (or/c #f #t stx?)])]{ [internal-context (or/c #f #t stx?)])]{
Represents a @racket[module] declaration. The @racket[body] forms use Represents a @racket[module] declaration.
@racket[prefix], rather than any prefix in place for the module
declaration itself (and each @racket[syntax-body] has its own prefix).
The @racket[provides] and @racket[requires] lists are each an The @racket[provides] and @racket[requires] lists are each an
association list from phases to exports or imports. In the case of association list from phases to exports or imports. In the case of
@ -173,15 +175,21 @@ structures that are produced by @racket[zo-parse] and consumed by
variables, and another for exported syntax. In the case of variables, and another for exported syntax. In the case of
@racket[requires], each phase maps to a list of imported module paths. @racket[requires], each phase maps to a list of imported module paths.
The @racket[body] field contains the module's run-time code, and The @racket[body] field contains the module's run-time (i.e., phase
@racket[syntax-body] contains the module's compile-time code. After 0) code. The @racket[syntax-bodies] list has a list of forms for
each form in @racket[body] or @racket[syntax-body] is evaluated, the each higher phase in the module body; the phases are in order
stack is restored to its depth from before evaluating the form. starting with phase 1. The @racket[body] forms use @racket[prefix],
rather than any prefix in place for the module declaration itself,
while members of lists in @racket[syntax-bodies] have their own
prefixes. After each form in @racket[body] or @racket[syntax-bodies]
is evaluated, the stack is restored to its depth from before
evaluating the form.
The @racket[unexported] list contains lists of symbols for unexported The @racket[unexported] list contains lists of symbols for
definitions that can be accessed through macro expansion. The first unexported definitions that can be accessed through macro expansion
list is phase-0 variables, the second is phase-0 syntax, and the last and that are implemented through the forms in @racket[body] and
is phase-1 variables. @racket[syntax-bodies]. Each list in @racket[unexported] starts
with a phase level.
The @racket[max-let-depth] field indicates the maximum stack depth The @racket[max-let-depth] field indicates the maximum stack depth
created by @racket[body] forms (not counting the @racket[prefix] created by @racket[body] forms (not counting the @racket[prefix]
@ -202,8 +210,8 @@ structures that are produced by @racket[zo-parse] and consumed by
([name symbol?] ([name symbol?]
[src (or/c module-path-index? #f)] [src (or/c module-path-index? #f)]
[src-name symbol?] [src-name symbol?]
[nom-mod (or/c module-path-index? #f)] [nom-src (or/c module-path-index? #f)]
[src-phase (or/c 0 1)] [src-phase exact-nonnegative-integer?]
[protected? boolean?])]{ [protected? boolean?])]{
Describes an individual provided identifier within a @racket[mod] Describes an individual provided identifier within a @racket[mod]
instance.} instance.}

21
collects/scribblings/reference/eval-model.scrbl
View File

@ -556,15 +556,18 @@ effect on further program parsing, as described in
@secref["intro-binding"]. @secref["intro-binding"].
Within a module, some definitions are shifted by a phase already; the Within a module, some definitions are shifted by a phase already; the
@racket[define-for-syntax] form is like @racket[define], but it @racket[begin-for-syntax] form is similar to @racket[begin], but it
defines a variable at relative @tech{phase} 1, instead of relative shifts expressions and definitions by a relative @tech{phase} 1.
@tech{phase} 0. Thus, if the module is @tech{instantiate}d at phase 1, Thus, if the module is @tech{instantiate}d at phase 1,
the variables for @racket[define-for-syntax] are created at phase 2, the variables defined with @racket[begin-for-syntax] are created at phase 2,
and so on. Moreover, this relative phase acts as another layer of and so on. Moreover, this relative phase acts as another layer of
prefixing, so that a @racket[define] of @racket[x] and a prefixing, so that a @racket[define] of @racket[x] and a
@racket[define-for-syntax] of @racket[x] can co-exist in a module @racket[begin-for-syntax]-wrapped
without colliding. Again, the higher phases are mainly related to @racket[define] of @racket[x] can co-exist in a module
program parsing, instead of normal evaluation. without colliding. A @racket[begin-for-syntax] form can be nested
within a @racket[begin-for-syntax] form, in which case definitions and
expressions are in relative @tech{phase} 2, and so on. Higher phases are
mainly related to program parsing, instead of normal evaluation.
If a module @tech{instantiate}d at @tech{phase} @math{n} If a module @tech{instantiate}d at @tech{phase} @math{n}
@racket[require]s another module, then the @racket[require]d module is @racket[require]s another module, then the @racket[require]d module is
@ -588,7 +591,7 @@ module forms (see @secref["mod-parse"]), and are, again, conceptually
distinguished by prefixes. distinguished by prefixes.
Top-level variables can exist in multiple phases in the same way as Top-level variables can exist in multiple phases in the same way as
within modules. For example, @racket[define-for-syntax] creates a within modules. For example, @racket[define] within @racket[begin-for-syntax] creates a
@tech{phase} 1 variable. Furthermore, reflective operations like @tech{phase} 1 variable. Furthermore, reflective operations like
@racket[make-base-namespace] and @racket[eval] provide access to @racket[make-base-namespace] and @racket[eval] provide access to
top-level variables in higher @tech{phases}, while module top-level variables in higher @tech{phases}, while module

30
collects/scribblings/reference/stx-trans.scrbl
View File

@ -473,8 +473,9 @@ to a top-level definition. A compile-time expression in a
@racket[letrec-syntaxes+values] or @racket[define-syntaxes] binding is @racket[letrec-syntaxes+values] or @racket[define-syntaxes] binding is
lifted to a @racket[let] wrapper around the corresponding right-hand lifted to a @racket[let] wrapper around the corresponding right-hand
side of the binding. A compile-time expression within side of the binding. A compile-time expression within
@racket[begin-for-syntax] is lifted to a @racket[define-for-syntax] @racket[begin-for-syntax] is lifted to a @racket[define]
declaration just before the requesting expression. declaration just before the requesting expression within the
@racket[begin-for-syntax].
Other syntactic forms can capture lifts by using Other syntactic forms can capture lifts by using
@racket[local-expand/capture-lifts] or @racket[local-expand/capture-lifts] or
@ -524,9 +525,8 @@ then the @exnraise[exn:fail:contract].}
Lifts a @racket[#%require] form corresponding to Lifts a @racket[#%require] form corresponding to
@racket[raw-require-spec] (either as a @tech{syntax object} or datum) @racket[raw-require-spec] (either as a @tech{syntax object} or datum)
to the top-level or to the top of the module currently being expanded, to the top-level or to the top of the module currently being expanded
wrapping it with @racket[for-meta] if the current expansion context is or to an enclosing @racket[begin-for-syntax]..
not @tech{phase level} 0.
The resulting syntax object is the same as @racket[stx], except that a The resulting syntax object is the same as @racket[stx], except that a
fresh @tech{syntax mark} is added. The same @tech{syntax mark} is fresh @tech{syntax mark} is added. The same @tech{syntax mark} is
@ -551,7 +551,7 @@ by the macro expander can prevent access to the new imports.
Lifts a @racket[#%provide] form corresponding to Lifts a @racket[#%provide] form corresponding to
@racket[raw-provide-spec-stx] to the top of the module currently being @racket[raw-provide-spec-stx] to the top of the module currently being
expanded. expanded or to an enclosing @racket[begin-for-syntax].
@transform-time[] If the current expression being transformed is not @transform-time[] If the current expression being transformed is not
within a @racket[module] form, or if it is not a run-time expression, within a @racket[module] form, or if it is not a run-time expression,
@ -732,20 +732,20 @@ Returns @racket[#t] while a @tech{provide transformer} is running (see
@racket[#%provide] is expanded, @racket[#f] otherwise.} @racket[#%provide] is expanded, @racket[#f] otherwise.}
@defproc[(syntax-local-module-defined-identifiers) @defproc[(syntax-local-module-defined-identifiers) (and/c hash? immutable?)]{
(values (listof identifier?) (listof identifier?))]{
Can be called only while Can be called only while
@racket[syntax-local-transforming-module-provides?] returns @racket[syntax-local-transforming-module-provides?] returns
@racket[#t]. @racket[#t].
It returns two lists of identifiers corresponding to all definitions It returns a hash table mapping a @tech{phase-level} number (such as
@racket[0]) to a list of all definitions at that @tech{phase level}
within the module being expanded. This information is used for within the module being expanded. This information is used for
implementing @racket[provide] sub-forms like @racket[all-defined-out]. implementing @racket[provide] sub-forms like @racket[all-defined-out].
The first result list corresponds to @tech{phase} 0 (i.e., normal) Beware that the @tech{phase-level} keys are absolute relative to the
definitions, and the second corresponds to @tech{phase} -1 (i.e., enclosing module, and not relative to the current transformer phase
for-syntax) definitions.} level as reported by @racket[syntax-local-phase-level].}
@defproc[(syntax-local-module-required-identifiers @defproc[(syntax-local-module-required-identifiers
@ -769,7 +769,11 @@ with a @racket[phase-level] shift, of all shifts if
When an identifier is renamed on import, the result association list When an identifier is renamed on import, the result association list
includes the identifier by its internal name. Use includes the identifier by its internal name. Use
@racket[identifier-binding] to obtain more information about the @racket[identifier-binding] to obtain more information about the
identifier.} identifier.
Beware that the @tech{phase-level} keys are absolute relative to the
enclosing module, and not relative to the current transformer phase
level as reported by @racket[syntax-local-phase-level].}
@deftogether[( @deftogether[(
@defthing[prop:liberal-define-context struct-type-property?] @defthing[prop:liberal-define-context struct-type-property?]

68
collects/scribblings/reference/syntax-model.scrbl
View File

@ -11,19 +11,19 @@ The syntax of a Racket program is defined by
@itemize[ @itemize[
@item{a @deftech{read} phase that processes a character stream into a @item{a @deftech{read} pass that processes a character stream into a
@tech{syntax object}; and} @tech{syntax object}; and}
@item{an @deftech{expand} phase that processes a syntax object to @item{an @deftech{expand} pass that processes a syntax object to
produce one that is fully parsed.} produce one that is fully parsed.}
] ]
For details on the @tech{read} phase, see @secref["reader"]. Source For details on the @tech{read} pass, see @secref["reader"]. Source
code is normally read in @racket[read-syntax] mode, which produces a code is normally read in @racket[read-syntax] mode, which produces a
@tech{syntax object}. @tech{syntax object}.
The @tech{expand} phase recursively processes a @tech{syntax object} The @tech{expand} pass recursively processes a @tech{syntax object}
to produce a complete @tech{parse} of the program. @tech{Binding} to produce a complete @tech{parse} of the program. @tech{Binding}
information in a @tech{syntax object} drives the @tech{expansion} information in a @tech{syntax object} drives the @tech{expansion}
process, and when the @tech{expansion} process encounters a process, and when the @tech{expansion} process encounters a
@ -186,7 +186,7 @@ the binding (according to @racket[free-identifier=?]) matters.}
@racketgrammar*[ @racketgrammar*[
#:literals (#%expression module #%plain-module-begin begin #%provide #:literals (#%expression module #%plain-module-begin begin #%provide
define-values define-syntaxes define-values-for-syntax define-values define-syntaxes begin-for-syntax
#%require #%require
#%plain-lambda case-lambda if begin begin0 let-values letrec-values #%plain-lambda case-lambda if begin begin0 let-values letrec-values
set! quote-syntax quote with-continuation-mark set! quote-syntax quote with-continuation-mark
@ -196,13 +196,14 @@ the binding (according to @racket[free-identifier=?]) matters.}
(module id name-id (module id name-id
(#%plain-module-begin (#%plain-module-begin
module-level-form ...)) module-level-form ...))
(begin top-level-form ...)] (begin top-level-form ...)
(begin-for-syntax top-level-form ...)]
[module-level-form general-top-level-form [module-level-form general-top-level-form
(#%provide raw-provide-spec ...)] (#%provide raw-provide-spec ...)
(begin-for-syntax module-level-form ...)]
[general-top-level-form expr [general-top-level-form expr
(define-values (id ...) expr) (define-values (id ...) expr)
(define-syntaxes (id ...) expr) (define-syntaxes (id ...) expr)
(define-values-for-syntax (id ...) expr)
(#%require raw-require-spec ...)] (#%require raw-require-spec ...)]
[expr id [expr id
(#%plain-lambda formals expr ...+) (#%plain-lambda formals expr ...+)
@ -243,15 +244,14 @@ binding to the @racket[#%plain-lambda] of the
syntactic-form names refer to the bindings defined in syntactic-form names refer to the bindings defined in
@secref["syntax"]. @secref["syntax"].
Only @tech{phase levels} 0 and 1 are relevant for the parse of a In a fully expanded program for a namespace whose @tech{base phase} is
program (though the @racket[_datum] in a @racket[quote-syntax] form 0, the relevant @tech{phase level} for a binding in the program is
preserves its information for all @tech{phase level}s). In particular, @math{N} if the bindings has @math{N} surrounding
the relevant @tech{phase level} is 0, except for the @racket[_expr]s @racket[begin-for-syntax] and @racket[define-syntaxes] forms---not
in a @racket[define-syntax], @racket[define-syntaxes], counting any @racket[begin-for-syntax] forms that wrap a
@racket[define-for-syntax], or @racket[define-values-for-syntax] form, @racket[module] form for the body of the @racket[module]. The
in which case the relevant @tech{phase level} is 1 (for which @racket[_datum] in a @racket[quote-syntax] form, however, always
comparisons are made using @racket[free-transformer-identifier=?] preserves its information for all @tech{phase level}s.
instead of @racket[free-identifier=?]).
In addition to the grammar above, @racket[letrec-syntaxes+values] can In addition to the grammar above, @racket[letrec-syntaxes+values] can
appear in a fully local-expanded expression, as can appear in a fully local-expanded expression, as can
@ -427,11 +427,13 @@ core syntactic forms are encountered:
at @tech{phase level} 0 (i.e., the @tech{base environment} is at @tech{phase level} 0 (i.e., the @tech{base environment} is
extended).} extended).}
@item{When a @racket[define-for-syntax] or @item{When a @racket[begin-for-syntax] form is encountered at the top
@racket[define-values-for-syntax] form is encountered at the level or module level, bindings are introduced as for
top level or module level, bindings are introduced as for @racket[define-values] and @racket[define-syntaxes], but at
@racket[define-values], but at @tech{phase level} 1 (i.e., the @tech{phase level} 1 (i.e., the @tech{transformer environment}
@tech{transformer environment} is extended).} is extended). More generally, @racket[begin-for-syntax] forms
can be nested, an each @racket[begin-for-syntax] shifts its
body definition by one @tech{phase level}.}
@item{When a @racket[let-values] form is encountered, the body of the @item{When a @racket[let-values] form is encountered, the body of the
@racket[let-values] form is extended (by creating new @racket[let-values] form is extended (by creating new
@ -578,11 +580,11 @@ to its handling of @racket[define-syntaxes]. A
level @math{n} (not just 0), in which case the expression for the level @math{n} (not just 0), in which case the expression for the
@tech{transformer binding} is expanded at @tech{phase level} @math{n+1}. @tech{transformer binding} is expanded at @tech{phase level} @math{n+1}.
The expression in a @racket[define-for-syntax] or The expressions in a @racket[begin-for-syntax] form are expanded and
@racket[define-values-for-syntax] form is expanded and evaluated in evaluated in the same way as for @racket[define-syntaxes]. However,
the same way as for @racket[syntax]. However, the introduced binding any introduced bindings from definition within
is a variable binding at @tech{phase level} 1 (not a @tech{transformer @racket[begin-for-syntax] are at @tech{phase level} 1 (not a
binding} at @tech{phase level} 0). @tech{transformer binding} at @tech{phase level} 0).
@;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@subsection[#:tag "partial-expansion"]{Partial Expansion} @subsection[#:tag "partial-expansion"]{Partial Expansion}
@ -654,10 +656,10 @@ the @racket[letrec-syntaxes+values] form.
A @racket[require] form not only introduces @tech{bindings} at A @racket[require] form not only introduces @tech{bindings} at
expansion time, but also @deftech{visits} the referenced module when expansion time, but also @deftech{visits} the referenced module when
it is encountered by the expander. That is, the expander it is encountered by the expander. That is, the expander instantiates
instantiates any @racket[define-for-syntax]ed variables defined any variables defined in the module within @racket[begin-for-syntax],
in the module, and also evaluates all expressions for and it also evaluates all expressions for @racket[define-syntaxes]
@racket[define-syntaxes] @tech{transformer bindings}. @tech{transformer bindings}.
Module @tech{visits} propagate through @racket[require]s in the same Module @tech{visits} propagate through @racket[require]s in the same
way as module @tech{instantiation}. Moreover, when a module is way as module @tech{instantiation}. Moreover, when a module is
@ -673,8 +675,8 @@ implicitly @tech{visit}ed. Thus, when the expander encounters
@tech{instantiate}s the required module at @tech{phase} 1, in addition @tech{instantiate}s the required module at @tech{phase} 1, in addition
to adding bindings at @tech{phase level} 1 (i.e., the to adding bindings at @tech{phase level} 1 (i.e., the
@tech{transformer environment}). Similarly, the expander immediately @tech{transformer environment}). Similarly, the expander immediately
evaluates any @racket[define-values-for-syntax] form that it evaluates any form that it encounters within
encounters. @racket[begin-for-syntax].
@tech{Phases} beyond 0 are @tech{visit}ed on demand. For example, @tech{Phases} beyond 0 are @tech{visit}ed on demand. For example,
when the right-hand side of a @tech{phase}-0 @racket[let-syntax] is to when the right-hand side of a @tech{phase}-0 @racket[let-syntax] is to

90
collects/scribblings/reference/syntax.scrbl
View File

@ -152,18 +152,26 @@ action depends on the shape of the form:
out into the module's body and immediately processed in place of the out into the module's body and immediately processed in place of the
@racket[begin].} @racket[begin].}
@item{If it is a @racket[define-syntaxes] or @item{If it is a @racket[define-syntaxes] form, then the right-hand side is
@racket[define-values-for-syntax] form, then the right-hand side is
evaluated (in @tech{phase} 1), and the binding is immediately evaluated (in @tech{phase} 1), and the binding is immediately
installed for further partial expansion within the installed for further partial expansion within the
module. Evaluation of the right-hand side is @racket[parameterize]d module. Evaluation of the right-hand side is @racket[parameterize]d
to set @racket[current-namespace] as in @racket[let-syntax].} to set @racket[current-namespace] as in @racket[let-syntax].}
@item{If the form is a @racket[require] form, bindings are introduced @item{If it is a @racket[begin-for-syntax] form, then the body is
expanded (in @tech{phase} 1) and evaluated. Expansion within a
@racket[begin-for-syntax] form proceeds with the same
partial-expansion process as for a @racket[module] body, but in a
higher @tech{phase}, and saving all @racket[#%provide] forms for all
phases until the end of the @racket[module]'s expansion. Evaluation
of the body is @racket[parameterize]d to set
@racket[current-namespace] as in @racket[let-syntax].}
@item{If the form is a @racket[#%require] form, bindings are introduced
immediately, and the imported modules are @tech{instantiate}d or immediately, and the imported modules are @tech{instantiate}d or
@tech{visit}ed as appropriate.} @tech{visit}ed as appropriate.}
@item{If the form is a @racket[provide] form, then it is recorded for @item{If the form is a @racket[#%provide] form, then it is recorded for
processing after the rest of the body.} processing after the rest of the body.}
@item{If the form is a @racket[define-values] form, then the binding @item{If the form is a @racket[define-values] form, then the binding
@ -177,7 +185,9 @@ action depends on the shape of the form:
After all @racket[form]s have been partially expanded this way, then After all @racket[form]s have been partially expanded this way, then
the remaining expression forms (including those on the right-hand side the remaining expression forms (including those on the right-hand side
of a definition) are expanded in an expression context. of a definition) are expanded in an expression context. Finally,
@racket[#%provide] forms are processed in the order in which they
appear (independent of @tech{phase}) in the expanded module.
The scope of all imported identifiers covers the entire module body, The scope of all imported identifiers covers the entire module body,
as does the scope of any identifier defined within the module body. as does the scope of any identifier defined within the module body.
@ -707,7 +717,10 @@ A @racket[provide-spec] indicates one or more bindings to provide.
For each exported binding, the external name is a symbol that can be For each exported binding, the external name is a symbol that can be
different from the symbolic form of the identifier that is bound different from the symbolic form of the identifier that is bound
within the module. Also, each export is drawn from a particular within the module. Also, each export is drawn from a particular
@tech{phase level} and exported at the same @tech{phase level}. @tech{phase level} and exported at the same @tech{phase level}; by
default, the relevant phase level is the number of
@racket[begin-for-syntax] forms that enclose the @racket[provide]
form.
The syntax of @racket[provide-spec] can be extended via The syntax of @racket[provide-spec] can be extended via
@racket[define-provide-syntax], but the pre-defined forms are as @racket[define-provide-syntax], but the pre-defined forms are as
@ -733,7 +746,7 @@ follows.
@racket[make-rename-transformer] for more information.} @racket[make-rename-transformer] for more information.}
@defsubform[(all-defined-out)]{ Exports all identifiers that are @defsubform[(all-defined-out)]{ Exports all identifiers that are
defined at @tech{phase level} 0 or @tech{phase level} 1 within the defined at the relevant @tech{phase level} within the
exporting module, and that have the same lexical context as the exporting module, and that have the same lexical context as the
@racket[(all-defined-out)] form, excluding bindings to @tech{rename @racket[(all-defined-out)] form, excluding bindings to @tech{rename
transformers} where the target identifier has the transformers} where the target identifier has the
@ -776,7 +789,7 @@ follows.
@defsubform[(rename-out [orig-id export-id] ...)]{ Exports each @defsubform[(rename-out [orig-id export-id] ...)]{ Exports each
@racket[orig-id], which must be @tech{bound} within the module at @racket[orig-id], which must be @tech{bound} within the module at
@tech{phase level} 0. The symbolic name for each export is the relevant @tech{phase level}. The symbolic name for each export is
@racket[export-id] instead @racket[orig-d]. @racket[export-id] instead @racket[orig-d].
@defexamples[#:eval (syntax-eval) @defexamples[#:eval (syntax-eval)
@ -821,8 +834,8 @@ follows.
@defsubform[(struct-out id)]{Exports the bindings associated with a @defsubform[(struct-out id)]{Exports the bindings associated with a
structure type @racket[id]. Typically, @racket[id] is bound with structure type @racket[id]. Typically, @racket[id] is bound with
@racket[(struct id ....)]; more generally, @racket[id] must have a @racket[(struct id ....)]; more generally, @racket[id] must have a
@tech{transformer binding} of structure-type information at @tech{transformer binding} of structure-type information at the relevant
@tech{phase level} 0; see @secref["structinfo"]. Furthermore, for @tech{phase level}; see @secref["structinfo"]. Furthermore, for
each identifier mentioned in the structure-type information, the each identifier mentioned in the structure-type information, the
enclosing module must define or import one identifier that is enclosing module must define or import one identifier that is
@racket[free-identifier=?]. If the structure-type information @racket[free-identifier=?]. If the structure-type information
@ -877,17 +890,21 @@ follows.
@specsubform[#:literals (for-meta) @specsubform[#:literals (for-meta)
(for-meta phase-level provide-spec ...)]{ Like the union of the (for-meta phase-level provide-spec ...)]{ Like the union of the
@racket[provide-spec]s, but adjusted to apply to @tech{phase level} @racket[provide-spec]s, but adjusted to apply to the @tech{phase
specified by @racket[phase-level] (where @racket[#f] corresponds to the level} specified by @racket[phase-level] relative to the current
@tech{label phase level}). In particular, an @racket[_id] or @racket[rename-out] form as phase level (where @racket[#f] corresponds to the @tech{label phase
a @racket[provide-spec] refers to a binding at @racket[phase-level], an level}). In particular, an @racket[_id] or @racket[rename-out] form
@racket[all-defined-out] exports only @racket[phase-level] as a @racket[provide-spec] refers to a binding at
definitions, and an @racket[all-from-out] exports bindings @racket[phase-level] relative to the current level, an
imported with a shift by @racket[phase-level]. @racket[all-defined-out] exports only definitions at
@racket[phase-level] relative to the current phase level, and an
@racket[all-from-out] exports bindings imported with a shift by
@racket[phase-level].
@examples[#:eval (syntax-eval) @examples[#:eval (syntax-eval)
(module nest racket (module nest racket
(define-for-syntax eggs 2) (begin-for-syntax
(define eggs 2))
(define chickens 3) (define chickens 3)
(provide (for-syntax eggs) (provide (for-syntax eggs)
chickens)) chickens))
@ -905,7 +922,8 @@ follows.
chickens)) chickens))
(module nest2 racket (module nest2 racket
(define-for-syntax eggs 2) (begin-for-syntax
(define eggs 2))
(provide (for-syntax eggs))) (provide (for-syntax eggs)))
(require (for-meta 2 racket/base) (require (for-meta 2 racket/base)
(for-syntax 'nest2)) (for-syntax 'nest2))
@ -2138,9 +2156,9 @@ a @racket[define-syntaxes] form introduces local bindings.
Like @racket[define], except that the binding is at @tech{phase level} Like @racket[define], except that the binding is at @tech{phase level}
1 instead of @tech{phase level} 0 relative to its context. The 1 instead of @tech{phase level} 0 relative to its context. The
expression for the binding is also at @tech{phase level} 1. (See expression for the binding is also at @tech{phase level} 1. (See
@secref["id-model"] for information on @tech{phase levels}.) @secref["id-model"] for information on @tech{phase levels}.) The form
Evaluation of @racket[expr] side is @racket[parameterize]d to set is a shorthand for @racket[(begin-for-syntax (define id expr))] or
@racket[current-namespace] as in @racket[let-syntax]. @racket[(begin-for-syntax (define (head args) body ...+))].
Within a module, bindings introduced by @racket[define-for-syntax] Within a module, bindings introduced by @racket[define-for-syntax]
must appear before their uses or in the same must appear before their uses or in the same
@ -2275,18 +2293,24 @@ in tail position only if no @racket[body]s are present.
@defform[(begin-for-syntax form ...)]{ @defform[(begin-for-syntax form ...)]{
Allowed only in a @tech{top-level context} or @tech{module context}. Allowed only in a @tech{top-level context} or @tech{module context},
Each @racket[form] is partially expanded (see shifts the @tech{phase level} of each @racket[form] by one:
@secref["partial-expansion"]) to determine one of the following
classifications:
@itemize[ @itemize[
@item{@racket[define] or @racket[define-values] form: converted to @item{expressions reference bindings at a @tech{phase level} one
a @racket[define-values-for-syntax] form.} greater than in the context of the @racket[begin-for-syntax]
form;}
@item{@racket[require] form: content is wrapped with @item{@racket[define], @racket[define-values],
@racket[for-syntax].} @racket[define-syntax], and @racket[define-syntaxes] forms bind
at a @tech{phase level} one greater than in the context of the
@racket[begin-for-syntax] form;}
@item{in @racket[require] and @racket[provide] forms, the default
@tech{phase level} is greater, which is roughly like wrapping
the content of the @racket[require] form with
@racket[for-syntax];}
@item{expression form @racket[_expr]: converted to @item{expression form @racket[_expr]: converted to
@racket[(define-values-for-syntax () (begin _expr (values)))], which @racket[(define-values-for-syntax () (begin _expr (values)))], which
@ -2296,6 +2320,12 @@ classifications:
] ]
See also @racket[module] for information about expansion order and
partial expansion for @racket[begin-for-syntax] within a module
context. Evaluation of an @racket[expr] within
@racket[begin-for-syntax] is @racket[parameterize]d to set
@racket[current-namespace] as in @racket[let-syntax].
} }
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------

4
collects/syntax/kerncase.rkt
View File

@ -21,7 +21,7 @@
begin begin0 set! begin begin0 set!
with-continuation-mark with-continuation-mark
if #%plain-app #%expression if #%plain-app #%expression
define-values define-syntaxes define-values-for-syntax define-values define-syntaxes begin-for-syntax
module module
#%plain-module-begin #%plain-module-begin
#%require #%provide #%require #%provide
@ -78,7 +78,7 @@
begin0 begin0
define-values define-values
define-syntaxes define-syntaxes
define-values-for-syntax begin-for-syntax
set! set!
let-values let-values
letrec-values letrec-values

40
collects/tests/compiler/zo.rkt Normal file
View File

@ -0,0 +1,40 @@
#lang racket/base
(require racket/pretty
compiler/zo-parse
compiler/zo-marshal
compiler/decompile)
(define ex-mod1
'(module m racket
(begin-for-syntax
(define fs 10)
(list fs))
(define-syntax (m stx)
#'10)
(m)
(begin-for-syntax
(list fs))))
(define ex-mod2
'(module m racket
(define t 8)
(define s 10)
(provide t (protect-out s))))
(define (check ex-mod)
(let ([c (parameterize ([current-namespace (make-base-namespace)])
(compile ex-mod))])
(let ([o (open-output-bytes)])
(write c o)
(let ([p (zo-parse (open-input-bytes (get-output-bytes o)))])
(let ([b (zo-marshal p)])
(let ([p2 (zo-parse (open-input-bytes b))]
[to-string (lambda (p)
(let ([o (open-output-bytes)])
(print p o)
(get-output-string o)))])
(unless (equal? (to-string p) (to-string p2))
(error 'zo "failed on example: ~e" ex-mod))))))))
(check ex-mod1)
(check ex-mod2)

34
collects/tests/racket/module.rktl
View File

@ -194,6 +194,40 @@
(eval `(require 'f)) (eval `(require 'f))
(test (list* 'd 'b finished) values l))))) (test (list* 'd 'b finished) values l)))))
(let* ([n (make-base-namespace)]
[l null]
[here (lambda (v)
(set! l (cons v l)))])
(parameterize ([current-namespace n])
(eval `(module a racket/base
(require (for-syntax racket/base)
(for-meta 2 racket/base))
(define a 1)
(define-syntax (a-macro stx) #'-1)
(begin-for-syntax
(,here 'pma))
(begin-for-syntax
(,here 'ma)
(define a-meta 10)
(define-syntax (a-meta-macro stx) #'-1)
(begin-for-syntax
(define a-meta-meta 100)
(,here 'mma)))
(,here 'a)
(provide a a-macro (for-syntax a-meta-macro))))
(test '(ma mma pma) values l)
(set! l null)
(dynamic-require ''a #f)
(test '(a) values l)
(eval `10)
(test '(a) values l)
(dynamic-require ''a 0) ; => 'a is available...
(eval `10)
(test '(ma pma a) values l)
(eval '(begin-for-syntax)) ; triggers phase-1 visit => phase-2 instantiate
(test '(mma ma pma a) values l)
(void)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check redundant import and re-provide ;; Check redundant import and re-provide

2
collects/typed-racket/base-env/base-env.rkt
View File

@ -1293,7 +1293,7 @@
[syntax-local-make-delta-introducer (-> (-Syntax Sym) (-> (-Syntax Sym) (-Syntax Sym)))] [syntax-local-make-delta-introducer (-> (-Syntax Sym) (-> (-Syntax Sym) (-Syntax Sym)))]
[syntax-local-transforming-module-provides? (-> B)] [syntax-local-transforming-module-provides? (-> B)]
[syntax-local-module-defined-identifiers (-> (-values (list (-Syntax Sym) (-Syntax Sym))))] [syntax-local-module-defined-identifiers (-> (-HT (Un B -Int) (-lst (-Syntax Sym))))]
[syntax-local-module-required-identifiers (-> (-opt -Module-Path) (Un B -Int) (-lst (-pair (-opt -Int) (-lst (-Syntax Sym)))))] [syntax-local-module-required-identifiers (-> (-opt -Module-Path) (Un B -Int) (-lst (-pair (-opt -Int) (-lst (-Syntax Sym)))))]
;Section 11.5 ;Section 11.5

2
collects/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -187,7 +187,7 @@
[(#%require . _) (void)] [(#%require . _) (void)]
[(#%provide . _) (void)] [(#%provide . _) (void)]
[(define-syntaxes . _) (void)] [(define-syntaxes . _) (void)]
[(define-values-for-syntax . _) (void)] [(begin-for-syntax . _) (void)]
;; FIXME - we no longer need these special cases ;; FIXME - we no longer need these special cases
;; these forms are handled in pass1 ;; these forms are handled in pass1

11
doc/release-notes/racket/HISTORY.txt
View File

@ -1,3 +1,14 @@
Version 5.1.3.7
Generalized begin-with-syntax to allow phase-N definitions,
both variable and syntax, within a module for all N >= 0;
removed define-values-for-syntax from fully expanded forms;
added begin-with-syntax to fully expanded forms
Changed syntax-local-module-defined-identifiers to return
a table for all phases instead of just two values
compiler/zo-structs: removed def-for-syntax, added
seq-for-syntax, changed some mod fields, added field to
def-syntaxes
Version 5.1.3.4 Version 5.1.3.4
Add support for the collection links file, including Add support for the collection links file, including
(find-system-path 'links-file) and the raco link command (find-system-path 'links-file) and the raco link command

4
src/racket/include/schthread.h
View File

@ -150,7 +150,7 @@ typedef struct Thread_Local_Variables {
struct Scheme_Object *cached_mod_beg_stx_; struct Scheme_Object *cached_mod_beg_stx_;
struct Scheme_Object *cached_dv_stx_; struct Scheme_Object *cached_dv_stx_;
struct Scheme_Object *cached_ds_stx_; struct Scheme_Object *cached_ds_stx_;
struct Scheme_Object *cached_dvs_stx_; struct Scheme_Object *cached_bfs_stx_;
int cached_stx_phase_; int cached_stx_phase_;
struct Scheme_Object *cwv_stx_; struct Scheme_Object *cwv_stx_;
int cwv_stx_phase_; int cwv_stx_phase_;
@ -488,7 +488,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define cached_mod_beg_stx XOA (scheme_get_thread_local_variables()->cached_mod_beg_stx_) #define cached_mod_beg_stx XOA (scheme_get_thread_local_variables()->cached_mod_beg_stx_)
#define cached_dv_stx XOA (scheme_get_thread_local_variables()->cached_dv_stx_) #define cached_dv_stx XOA (scheme_get_thread_local_variables()->cached_dv_stx_)
#define cached_ds_stx XOA (scheme_get_thread_local_variables()->cached_ds_stx_) #define cached_ds_stx XOA (scheme_get_thread_local_variables()->cached_ds_stx_)
#define cached_dvs_stx XOA (scheme_get_thread_local_variables()->cached_dvs_stx_) #define cached_bfs_stx XOA (scheme_get_thread_local_variables()->cached_bfs_stx_)
#define cached_stx_phase XOA (scheme_get_thread_local_variables()->cached_stx_phase_) #define cached_stx_phase XOA (scheme_get_thread_local_variables()->cached_stx_phase_)
#define cwv_stx XOA (scheme_get_thread_local_variables()->cwv_stx_) #define cwv_stx XOA (scheme_get_thread_local_variables()->cwv_stx_)
#define cwv_stx_phase XOA (scheme_get_thread_local_variables()->cwv_stx_phase_) #define cwv_stx_phase XOA (scheme_get_thread_local_variables()->cwv_stx_phase_)

2
src/racket/src/compenv.c
View File

@ -1883,7 +1883,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
/* Try syntax table: */ /* Try syntax table: */
if (modname) { if (modname) {
val = scheme_module_syntax(modname, env->genv, find_id); val = scheme_module_syntax(modname, env->genv, find_id, SCHEME_INT_VAL(mod_defn_phase));
if (val && !(flags & SCHEME_NO_CERT_CHECKS)) if (val && !(flags & SCHEME_NO_CERT_CHECKS))
scheme_check_accessible_in_module(genv, env->insp, in_modidx, scheme_check_accessible_in_module(genv, env->insp, in_modidx,
find_id, src_find_id, NULL, NULL, rename_insp, find_id, src_find_id, NULL, NULL, rename_insp,

146
src/racket/src/compile.c
View File

@ -108,8 +108,8 @@ static Scheme_Object *quote_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *
static Scheme_Object *quote_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); static Scheme_Object *quote_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec); static Scheme_Object *define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *define_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); static Scheme_Object *define_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *define_for_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec); static Scheme_Object *begin_for_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *define_for_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); static Scheme_Object *begin_for_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *letrec_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec); static Scheme_Object *letrec_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *letrec_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); static Scheme_Object *letrec_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
@ -273,9 +273,9 @@ void scheme_init_compile (Scheme_Env *env)
quote_syntax_expand), quote_syntax_expand),
env); env);
scheme_add_global_keyword("define-syntaxes", scheme_define_syntaxes_syntax, env); scheme_add_global_keyword("define-syntaxes", scheme_define_syntaxes_syntax, env);
scheme_add_global_keyword("define-values-for-syntax", scheme_add_global_keyword("begin-for-syntax",
scheme_make_compiled_syntax(define_for_syntaxes_syntax, scheme_make_compiled_syntax(begin_for_syntax_syntax,
define_for_syntaxes_expand), begin_for_syntax_expand),
env); env);
scheme_add_global_keyword("letrec-syntaxes+values", scheme_add_global_keyword("letrec-syntaxes+values",
scheme_make_compiled_syntax(letrec_syntaxes_syntax, scheme_make_compiled_syntax(letrec_syntaxes_syntax,
@ -3135,7 +3135,7 @@ single_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info
form_name = SCHEME_STX_CAR(form); form_name = SCHEME_STX_CAR(form);
if (simplify && (erec[drec].depth == -1)) { if (simplify && (erec[drec].depth == -1)) {
/* FIXME: this needs EXPAND_OBSERVE callbacks. */ /* FIXME [Ryan?]: this needs EXPAND_OBSERVE callbacks? */
expr = scheme_stx_track(expr, form, form_name); expr = scheme_stx_track(expr, form, form_name);
SCHEME_EXPAND_OBSERVE_TAG(erec[drec].observer,expr); SCHEME_EXPAND_OBSERVE_TAG(erec[drec].observer,expr);
return expr; return expr;
@ -3224,6 +3224,19 @@ quote_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Inf
/* define-syntaxes */ /* define-syntaxes */
/**********************************************************************/ /**********************************************************************/
static void prep_exp_env_compile_rec(Scheme_Compile_Info *rec, int drec)
{
rec[0].comp = 1;
rec[0].dont_mark_local_use = 0;
rec[0].resolve_module_ids = 0;
rec[0].value_name = NULL;
rec[0].observer = NULL;
rec[0].pre_unwrapped = 0;
rec[0].testing_constantness = 0;
rec[0].env_already = 0;
rec[0].comp_flags = rec[drec].comp_flags;
}
static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env) static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env)
{ {
Scheme_Env *env = (Scheme_Env *)_env; Scheme_Env *env = (Scheme_Env *)_env;
@ -3233,7 +3246,7 @@ static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env)
static Scheme_Object * static Scheme_Object *
do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec, int for_stx) Scheme_Compile_Info *rec, int drec)
{ {
Scheme_Object *names, *code, *dummy; Scheme_Object *names, *code, *dummy;
Scheme_Object *val, *vec; Scheme_Object *val, *vec;
@ -3248,27 +3261,13 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
scheme_prepare_exp_env(env->genv); scheme_prepare_exp_env(env->genv);
scheme_prepare_compile_env(env->genv->exp_env); scheme_prepare_compile_env(env->genv->exp_env);
if (!for_stx) names = scheme_named_map_1(NULL, stx_val, names, (Scheme_Object *)env->genv);
names = scheme_named_map_1(NULL, stx_val, names, (Scheme_Object *)env->genv);
exp_env = scheme_new_comp_env(env->genv->exp_env, env->insp, 0); exp_env = scheme_new_comp_env(env->genv->exp_env, env->insp, 0);
dummy = scheme_make_environment_dummy(env); dummy = scheme_make_environment_dummy(env);
rec1.comp = 1;
rec1.dont_mark_local_use = 0;
rec1.resolve_module_ids = 0;
rec1.value_name = NULL;
rec1.observer = NULL;
rec1.pre_unwrapped = 0;
rec1.testing_constantness = 0;
rec1.env_already = 0;
rec1.comp_flags = rec[drec].comp_flags;
if (for_stx) { prep_exp_env_compile_rec(&rec1, 0);
names = defn_targets_syntax(names, exp_env, &rec1, 0);
scheme_compile_rec_done_local(&rec1, 0);
}
val = scheme_compile_expr_lift_to_let(code, exp_env, &rec1, 0); val = scheme_compile_expr_lift_to_let(code, exp_env, &rec1, 0);
@ -3278,7 +3277,7 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
SCHEME_VEC_ELS(vec)[2] = names; SCHEME_VEC_ELS(vec)[2] = names;
SCHEME_VEC_ELS(vec)[3] = val; SCHEME_VEC_ELS(vec)[3] = val;
vec->type = (for_stx ? scheme_define_for_syntax_type : scheme_define_syntaxes_type); vec->type = scheme_define_syntaxes_type;
scheme_merge_undefineds(exp_env, env); scheme_merge_undefineds(exp_env, env);
@ -3289,14 +3288,7 @@ static Scheme_Object *
define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec) Scheme_Compile_Info *rec, int drec)
{ {
return do_define_syntaxes_syntax(form, env, rec, drec, 0); return do_define_syntaxes_syntax(form, env, rec, drec);
}
static Scheme_Object *
define_for_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
return do_define_syntaxes_syntax(form, env, rec, drec, 1);
} }
static Scheme_Object * static Scheme_Object *
@ -3328,9 +3320,91 @@ define_syntaxes_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Ex
} }
static Scheme_Object * static Scheme_Object *
define_for_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec) begin_for_syntax_expand(Scheme_Object *orig_form, Scheme_Comp_Env *in_env, Scheme_Expand_Info *rec, int drec)
{ {
return define_syntaxes_expand(form, env, erec, drec); Scheme_Expand_Info recs[1];
Scheme_Object *form, *context_key, *l, *fn, *vec, *dummy;
Scheme_Comp_Env *env;
/* FIXME [Ryan?]: */
/* SCHEME_EXPAND_OBSERVE_PRIM_DEFINE_SYNTAXES(erec[drec].observer); */
form = orig_form;
if (!scheme_is_toplevel(in_env))
scheme_wrong_syntax(NULL, NULL, form, "illegal use (not at top-level)");
(void)check_form(form, form);
scheme_prepare_exp_env(in_env->genv);
scheme_prepare_compile_env(in_env->genv->exp_env);
if (rec[drec].comp)
env = scheme_new_comp_env(in_env->genv->exp_env, in_env->insp, 0);
else
env = scheme_new_expand_env(in_env->genv->exp_env, in_env->insp, 0);
if (rec[drec].comp)
dummy = scheme_make_environment_dummy(in_env);
else
dummy = NULL;
context_key = scheme_generate_lifts_key();
l = SCHEME_STX_CDR(form);
form = scheme_null;
while (1) {
scheme_frame_captures_lifts(env, scheme_make_lifted_defn, scheme_sys_wraps(env),
scheme_false, scheme_false, scheme_null, scheme_false);
if (rec[drec].comp) {
scheme_init_compile_recs(rec, drec, recs, 1);
prep_exp_env_compile_rec(recs, 0);
l = scheme_compile_list(l, env, recs, 0);
} else {
scheme_init_expand_recs(rec, drec, recs, 1);
l = scheme_expand_list(l, env, recs, 0);
}
if (SCHEME_NULLP(form))
form = l;
else
form = scheme_append(l, form);
l = scheme_frame_get_lifts(env);
if (SCHEME_NULLP(l)) {
/* No lifts */
if (rec[drec].comp)
scheme_merge_compile_recs(rec, drec, NULL, 1); /* fix this if merge changes to do something */
break;
} else {
/* We have lifts: */
/* FIXME [Ryan?]: need some expand-observe callback here? */
}
}
if (rec[drec].comp) {
vec = scheme_make_vector(4, NULL);
SCHEME_VEC_ELS(vec)[0] = (Scheme_Object *)env->prefix;
SCHEME_VEC_ELS(vec)[1] = dummy;
SCHEME_VEC_ELS(vec)[2] = form;
vec->type = scheme_begin_for_syntax_type;
return vec;
} else {
fn = SCHEME_STX_CAR(orig_form);
return scheme_datum_to_syntax(cons(fn, form),
orig_form, orig_form,
0, 2);
}
}
static Scheme_Object *
begin_for_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
return begin_for_syntax_expand(form, env, rec, drec);
} }
Scheme_Object *scheme_make_environment_dummy(Scheme_Comp_Env *env) Scheme_Object *scheme_make_environment_dummy(Scheme_Comp_Env *env)
@ -4325,7 +4399,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
#if 1 #if 1
if (!SCHEME_STXP(form)) if (!SCHEME_STXP(form))
scheme_signal_error("not syntax"); scheme_signal_error("internal error: not syntax");
#endif #endif
if (rec[drec].comp) { if (rec[drec].comp) {
@ -4338,7 +4412,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
var = SCHEME_STX_VAL(form); var = SCHEME_STX_VAL(form);
if (scheme_stx_has_empty_wraps(form) if (scheme_stx_has_empty_wraps(form)
&& same_effective_env(SCHEME_PTR2_VAL(var), env)) { && same_effective_env(SCHEME_PTR2_VAL(var), env)) {
/* FIXME: this needs EXPAND_OBSERVE callbacks. */ /* FIXME [Ryan?]: this needs EXPAND_OBSERVE callbacks. */
form = scheme_stx_track(SCHEME_PTR1_VAL(var), form, form); form = scheme_stx_track(SCHEME_PTR1_VAL(var), form, form);
if (!rec[drec].comp && (rec[drec].depth != -1)) { if (!rec[drec].comp && (rec[drec].depth != -1)) {
/* Already fully expanded. */ /* Already fully expanded. */

315
src/racket/src/cstartup.inc
View File

@ -1,26 +1,26 @@
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,13,0,22, 0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,13,0,17,
0,26,0,31,0,38,0,51,0,58,0,63,0,68,0,72,0,79,0,82,0, 0,22,0,29,0,42,0,49,0,54,0,59,0,63,0,70,0,73,0,82,0,
85,0,91,0,105,0,119,0,122,0,128,0,132,0,134,0,145,0,147,0,161, 85,0,91,0,105,0,119,0,122,0,128,0,132,0,134,0,145,0,147,0,161,
0,168,0,190,0,192,0,206,0,17,1,46,1,57,1,68,1,93,1,126,1, 0,168,0,190,0,192,0,206,0,17,1,46,1,57,1,68,1,93,1,126,1,
159,1,218,1,17,2,95,2,150,2,155,2,175,2,68,3,88,3,140,3,206, 159,1,218,1,17,2,95,2,150,2,155,2,175,2,68,3,88,3,140,3,206,
3,95,4,237,4,34,5,45,5,124,5,0,0,69,7,0,0,69,35,37,109, 3,95,4,237,4,34,5,45,5,124,5,0,0,83,7,0,0,69,35,37,109,
105,110,45,115,116,120,29,11,11,68,104,101,114,101,45,115,116,120,63,108,101, 105,110,45,115,116,120,29,11,11,63,108,101,116,64,99,111,110,100,66,117,110,
116,64,99,111,110,100,66,117,110,108,101,115,115,72,112,97,114,97,109,101,116, 108,101,115,115,72,112,97,114,97,109,101,116,101,114,105,122,101,66,100,101,102,
101,114,105,122,101,66,100,101,102,105,110,101,64,119,104,101,110,64,108,101,116, 105,110,101,64,119,104,101,110,64,108,101,116,42,63,97,110,100,66,108,101,116,
42,63,97,110,100,66,108,101,116,114,101,99,62,111,114,29,11,11,65,113,117, 114,101,99,62,111,114,68,104,101,114,101,45,115,116,120,29,11,11,65,113,117,
111,116,101,29,94,2,15,68,35,37,107,101,114,110,101,108,11,29,94,2,15, 111,116,101,29,94,2,15,68,35,37,107,101,114,110,101,108,11,29,94,2,15,
68,35,37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105,110,63,115, 68,35,37,112,97,114,97,109,122,11,62,105,102,65,98,101,103,105,110,63,115,
116,120,61,115,70,108,101,116,45,118,97,108,117,101,115,61,120,73,108,101,116, 116,120,61,115,70,108,101,116,45,118,97,108,117,101,115,61,120,73,108,101,116,
114,101,99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1,20,112,97, 114,101,99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1,20,112,97,
114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,61,118,73, 114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,61,118,73,
100,101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,126,76,0, 100,101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,83,76,0,
0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,20,2,4, 0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,20,2,3,
2,2,2,6,2,2,2,8,2,2,2,7,2,2,2,9,2,2,2,10,2, 2,2,2,5,2,2,2,7,2,2,2,6,2,2,2,8,2,2,2,9,2,
2,2,11,2,2,2,5,2,2,2,12,2,2,2,13,2,2,97,37,11,8, 2,2,10,2,2,2,4,2,2,2,11,2,2,2,12,2,2,97,37,11,8,
240,126,76,0,0,93,159,2,16,36,37,16,2,2,3,161,2,2,37,2,3, 240,83,76,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,37,2,13,
2,2,2,3,96,11,11,8,240,126,76,0,0,16,0,96,38,11,8,240,126, 2,2,2,13,96,38,11,8,240,83,76,0,0,16,0,96,11,11,8,240,83,
76,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14,2,2,11, 76,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14,2,2,11,
11,8,32,8,31,8,30,8,29,27,248,22,155,4,195,249,22,148,4,80,158, 11,8,32,8,31,8,30,8,29,27,248,22,155,4,195,249,22,148,4,80,158,
39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,248,22,100,201, 39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,248,22,100,201,
@ -28,16 +28,16 @@
98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,22,155,4,196, 98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,22,155,4,196,
28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,75,194,248,22, 28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,75,194,248,22,
74,193,249,22,148,4,80,158,39,36,251,22,83,2,18,248,22,74,199,249,22, 74,193,249,22,148,4,80,158,39,36,251,22,83,2,18,248,22,74,199,249,22,
73,2,11,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2,2,11,11, 73,2,10,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2,2,11,11,
8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101,110,118,49, 8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,
52,56,48,57,16,4,11,11,2,21,3,1,8,101,110,118,49,52,56,49,48, 52,55,51,57,16,4,11,11,2,21,3,1,8,101,110,118,49,52,55,52,48,
27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36,37,28, 27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36,37,28,
248,22,81,248,22,75,194,248,22,74,193,249,22,148,4,80,158,39,36,250,22, 248,22,81,248,22,75,194,248,22,74,193,249,22,148,4,80,158,39,36,250,22,
83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201,251,22,83, 83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201,251,22,83,
2,18,2,23,2,23,249,22,73,2,13,248,22,75,204,18,100,11,13,16,5, 2,18,2,23,2,23,249,22,73,2,12,248,22,75,204,18,100,11,13,16,5,
36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20, 36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,
3,1,8,101,110,118,49,52,56,49,50,16,4,11,11,2,21,3,1,8,101, 3,1,8,101,110,118,49,52,55,52,50,16,4,11,11,2,21,3,1,8,101,
110,118,49,52,56,49,51,248,22,155,4,193,27,248,22,155,4,194,249,22,73, 110,118,49,52,55,52,51,248,22,155,4,193,27,248,22,155,4,194,249,22,73,
248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,155,4,23,197, 248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,155,4,23,197,
1,249,22,148,4,80,158,39,36,28,248,22,58,248,22,149,4,248,22,74,23, 1,249,22,148,4,80,158,39,36,28,248,22,58,248,22,149,4,248,22,74,23,
198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33,40,248,22, 198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33,40,248,22,
@ -51,7 +51,7 @@
163,8,36,37,47,11,9,222,33,43,248,22,155,4,248,22,74,201,248,22,75, 163,8,36,37,47,11,9,222,33,43,248,22,155,4,248,22,74,201,248,22,75,
198,27,248,22,75,248,22,155,4,196,27,248,22,155,4,248,22,74,195,249,22, 198,27,248,22,75,248,22,155,4,196,27,248,22,155,4,248,22,74,195,249,22,
148,4,80,158,40,36,28,248,22,81,195,250,22,84,2,22,9,248,22,75,199, 148,4,80,158,40,36,28,248,22,81,195,250,22,84,2,22,9,248,22,75,199,
250,22,83,2,4,248,22,83,248,22,74,199,250,22,84,2,10,248,22,75,201, 250,22,83,2,3,248,22,83,248,22,74,199,250,22,84,2,9,248,22,75,201,
248,22,75,202,27,248,22,75,248,22,155,4,23,197,1,27,249,22,1,22,87, 248,22,75,202,27,248,22,75,248,22,155,4,23,197,1,27,249,22,1,22,87,
249,22,2,22,155,4,248,22,155,4,248,22,74,199,248,22,174,4,249,22,148, 249,22,2,22,155,4,248,22,155,4,248,22,74,199,248,22,174,4,249,22,148,
4,80,158,41,36,251,22,83,1,22,119,105,116,104,45,99,111,110,116,105,110, 4,80,158,41,36,251,22,83,1,22,119,105,116,104,45,99,111,110,116,105,110,
@ -62,43 +62,44 @@
75,204,27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36, 75,204,27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36,
37,249,22,148,4,80,158,39,36,27,248,22,155,4,248,22,74,197,28,249,22, 37,249,22,148,4,80,158,39,36,27,248,22,155,4,248,22,74,197,28,249,22,
140,9,62,61,62,248,22,149,4,248,22,98,196,250,22,83,2,22,248,22,83, 140,9,62,61,62,248,22,149,4,248,22,98,196,250,22,83,2,22,248,22,83,
249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,5,249,22,83,2,27, 249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,4,249,22,83,2,27,
249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,83,2,18,28,249,22, 249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,83,2,18,28,249,22,
140,9,248,22,149,4,248,22,74,200,64,101,108,115,101,10,248,22,74,197,250, 140,9,248,22,149,4,248,22,74,200,64,101,108,115,101,10,248,22,74,197,250,
22,84,2,22,9,248,22,75,200,249,22,73,2,5,248,22,75,202,99,13,16, 22,84,2,22,9,248,22,75,200,249,22,73,2,4,248,22,75,202,99,13,16,
5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2, 5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,
20,3,1,8,101,110,118,49,52,56,51,53,16,4,11,11,2,21,3,1,8, 20,3,1,8,101,110,118,49,52,55,54,53,16,4,11,11,2,21,3,1,8,
101,110,118,49,52,56,51,54,18,158,94,10,64,118,111,105,100,8,48,27,248, 101,110,118,49,52,55,54,54,18,158,94,10,64,118,111,105,100,8,48,27,248,
22,75,248,22,155,4,196,249,22,148,4,80,158,39,36,28,248,22,58,248,22, 22,75,248,22,155,4,196,249,22,148,4,80,158,39,36,28,248,22,58,248,22,
149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,199,248,22,98, 149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,199,248,22,98,
198,27,248,22,149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74, 198,27,248,22,149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,
197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,112,159,36,16, 197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,112,159,36,16,
1,11,16,0,20,26,142,2,1,2,1,2,2,11,11,11,10,36,80,158,36, 1,11,16,0,20,26,146,2,1,2,1,2,2,11,11,11,10,36,80,158,36,
36,20,112,159,36,16,0,16,0,16,1,2,3,37,16,0,36,16,0,36,11, 36,20,112,159,36,16,0,16,0,38,39,36,16,0,36,16,0,36,11,11,11,
11,39,36,11,11,16,10,2,4,2,5,2,6,2,7,2,8,2,9,2,10, 16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,
2,11,2,12,2,13,16,10,11,11,11,11,11,11,11,11,11,11,16,10,2, 12,16,10,11,11,11,11,11,11,11,11,11,11,16,10,2,3,2,4,2,5,
4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,2,13,36,46, 2,6,2,7,2,8,2,9,2,10,2,11,2,12,36,46,37,16,0,36,16,
37,11,11,16,0,16,0,16,0,36,36,11,11,11,16,0,16,0,16,0,36, 1,2,13,37,11,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0,
36,16,11,16,5,2,3,20,14,159,36,36,36,36,20,112,159,36,16,0,16, 16,0,16,0,36,36,16,11,16,5,11,20,15,16,2,20,14,159,36,36,37,
1,33,33,10,16,5,2,6,88,163,8,36,37,53,37,9,223,0,33,34,36, 80,158,36,36,36,20,112,159,36,16,1,2,13,16,1,33,33,10,16,5,2,
20,112,159,36,16,1,2,3,16,0,11,16,5,2,9,88,163,8,36,37,53, 5,88,163,8,36,37,53,37,9,223,0,33,34,36,20,112,159,36,16,1,2,
37,9,223,0,33,35,36,20,112,159,36,16,1,2,3,16,0,11,16,5,2, 13,16,0,11,16,5,2,8,88,163,8,36,37,53,37,9,223,0,33,35,36,
11,88,163,8,36,37,53,37,9,223,0,33,36,36,20,112,159,36,16,1,2, 20,112,159,36,16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,53,
3,16,1,33,37,11,16,5,2,13,88,163,8,36,37,56,37,9,223,0,33, 37,9,223,0,33,36,36,20,112,159,36,16,1,2,13,16,1,33,37,11,16,
38,36,20,112,159,36,16,1,2,3,16,1,33,39,11,16,5,2,4,88,163, 5,2,12,88,163,8,36,37,56,37,9,223,0,33,38,36,20,112,159,36,16,
8,36,37,58,37,9,223,0,33,42,36,20,112,159,36,16,1,2,3,16,0, 1,2,13,16,1,33,39,11,16,5,2,3,88,163,8,36,37,58,37,9,223,
11,16,5,2,12,88,163,8,36,37,53,37,9,223,0,33,44,36,20,112,159, 0,33,42,36,20,112,159,36,16,1,2,13,16,0,11,16,5,2,11,88,163,
36,16,1,2,3,16,0,11,16,5,2,10,88,163,8,36,37,54,37,9,223, 8,36,37,53,37,9,223,0,33,44,36,20,112,159,36,16,1,2,13,16,0,
0,33,45,36,20,112,159,36,16,1,2,3,16,0,11,16,5,2,7,88,163, 11,16,5,2,9,88,163,8,36,37,54,37,9,223,0,33,45,36,20,112,159,
8,36,37,56,37,9,223,0,33,46,36,20,112,159,36,16,1,2,3,16,0, 36,16,1,2,13,16,0,11,16,5,2,6,88,163,8,36,37,56,37,9,223,
11,16,5,2,5,88,163,8,36,37,58,37,9,223,0,33,47,36,20,112,159, 0,33,46,36,20,112,159,36,16,1,2,13,16,0,11,16,5,2,4,88,163,
36,16,1,2,3,16,1,33,49,11,16,5,2,8,88,163,8,36,37,54,37, 8,36,37,58,37,9,223,0,33,47,36,20,112,159,36,16,1,2,13,16,1,
9,223,0,33,50,36,20,112,159,36,16,1,2,3,16,0,11,16,0,94,2, 33,49,11,16,5,2,7,88,163,8,36,37,54,37,9,223,0,33,50,36,20,
16,2,17,93,2,16,9,9,36,0}; 112,159,36,16,1,2,13,16,0,11,16,0,94,2,16,2,17,93,2,16,9,
EVAL_ONE_SIZED_STR((char *)expr, 2004); 9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 2018);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0,26, 0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0,26,
0,43,0,65,0,94,0,109,0,127,0,143,0,157,0,179,0,195,0,212,0, 0,43,0,65,0,94,0,109,0,127,0,143,0,157,0,179,0,195,0,212,0,
234,0,245,0,251,0,4,1,11,1,18,1,30,1,46,1,70,1,102,1,120, 234,0,245,0,251,0,4,1,11,1,18,1,30,1,46,1,70,1,102,1,120,
@ -110,7 +111,7 @@
15,17,23,17,129,17,192,17,194,17,50,18,110,18,115,18,238,18,249,18,129, 15,17,23,17,129,17,192,17,194,17,50,18,110,18,115,18,238,18,249,18,129,
19,139,19,62,21,84,21,93,21,86,22,104,22,118,22,77,23,96,23,34,26, 19,139,19,62,21,84,21,93,21,86,22,104,22,118,22,77,23,96,23,34,26,
154,30,68,31,213,31,198,32,180,33,187,33,12,34,95,34,180,34,206,34,79, 154,30,68,31,213,31,198,32,180,33,187,33,12,34,95,34,180,34,206,34,79,
35,0,0,180,39,0,0,67,35,37,117,116,105,108,115,72,112,97,116,104,45, 35,0,0,177,39,0,0,67,35,37,117,116,105,108,115,72,112,97,116,104,45,
115,116,114,105,110,103,63,64,98,115,98,115,76,110,111,114,109,97,108,45,99, 115,116,114,105,110,103,63,64,98,115,98,115,76,110,111,114,109,97,108,45,99,
97,115,101,45,112,97,116,104,1,20,102,105,110,100,45,101,120,101,99,117,116, 97,115,101,45,112,97,116,104,1,20,102,105,110,100,45,101,120,101,99,117,116,
97,98,108,101,45,112,97,116,104,1,27,112,97,116,104,45,108,105,115,116,45, 97,98,108,101,45,112,97,116,104,1,27,112,97,116,104,45,108,105,115,116,45,
@ -369,7 +370,7 @@
22,157,2,195,88,163,8,36,38,48,11,9,223,3,33,88,28,197,86,94,20, 22,157,2,195,88,163,8,36,38,48,11,9,223,3,33,88,28,197,86,94,20,
18,159,11,80,158,42,47,193,20,18,159,11,80,158,42,48,196,86,94,20,18, 18,159,11,80,158,42,47,193,20,18,159,11,80,158,42,48,196,86,94,20,18,
159,11,80,158,42,53,193,20,18,159,11,80,158,42,54,196,193,28,193,80,158, 159,11,80,158,42,53,193,20,18,159,11,80,158,42,54,196,193,28,193,80,158,
38,47,80,158,38,53,248,22,8,88,163,8,32,37,8,40,8,240,0,188,23, 38,47,80,158,38,53,248,22,9,88,163,8,32,37,8,40,8,240,0,188,23,
0,9,224,1,2,33,89,0,7,35,114,120,34,47,43,34,28,248,22,130,7, 0,9,224,1,2,33,89,0,7,35,114,120,34,47,43,34,28,248,22,130,7,
23,195,2,27,249,22,138,15,2,91,196,28,192,28,249,22,184,3,248,22,97, 23,195,2,27,249,22,138,15,2,91,196,28,192,28,249,22,184,3,248,22,97,
195,248,22,174,3,248,22,133,7,198,249,22,7,250,22,152,7,199,36,248,22, 195,248,22,174,3,248,22,133,7,198,249,22,7,250,22,152,7,199,36,248,22,
@ -541,7 +542,7 @@
28,23,194,2,23,194,1,86,94,23,194,1,36,249,22,185,5,23,199,1,20, 28,23,194,2,23,194,1,86,94,23,194,1,36,249,22,185,5,23,199,1,20,
20,95,88,163,8,36,36,48,11,9,224,4,2,33,107,23,195,1,23,197,1, 20,95,88,163,8,36,36,48,11,9,224,4,2,33,107,23,195,1,23,197,1,
27,248,22,170,5,23,195,1,248,80,159,39,8,31,39,193,159,36,20,112,159, 27,248,22,170,5,23,195,1,248,80,159,39,8,31,39,193,159,36,20,112,159,
36,16,1,11,16,0,20,26,142,2,1,2,1,29,11,11,11,11,11,10,43, 36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11,11,11,11,10,43,
80,158,36,36,20,112,159,40,16,28,2,2,2,3,2,4,2,5,2,6,2, 80,158,36,36,20,112,159,40,16,28,2,2,2,3,2,4,2,5,2,6,2,
7,2,8,2,9,2,10,2,11,2,12,2,13,2,14,2,15,30,2,18,76, 7,2,8,2,9,2,10,2,11,2,12,2,13,2,14,2,15,30,2,18,76,
102,105,110,100,45,108,105,110,107,115,45,112,97,116,104,33,4,30,2,19,1, 102,105,110,100,45,108,105,110,107,115,45,112,97,116,104,33,4,30,2,19,1,
@ -549,58 +550,58 @@
6,30,2,19,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101, 6,30,2,19,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,
114,105,122,97,116,105,111,110,3,2,20,2,21,2,22,30,2,18,1,21,101, 114,105,122,97,116,105,111,110,3,2,20,2,21,2,22,30,2,18,1,21,101,
120,99,101,112,116,105,111,110,45,104,97,110,100,108,101,114,45,107,101,121,2, 120,99,101,112,116,105,111,110,45,104,97,110,100,108,101,114,45,107,101,121,2,
2,23,2,24,2,25,2,26,2,27,2,28,2,29,16,0,16,0,36,16,0, 2,23,2,24,2,25,2,26,2,27,2,28,2,29,16,0,37,39,36,16,0,
36,16,12,2,8,2,7,2,3,2,24,2,22,2,20,2,15,2,21,2,23, 36,16,12,2,8,2,7,2,3,2,24,2,22,2,20,2,15,2,21,2,23,
2,13,2,12,2,14,48,11,11,39,36,11,11,16,12,2,11,2,9,2,29, 2,13,2,12,2,14,48,11,11,11,16,12,2,11,2,9,2,29,2,10,2,
2,10,2,5,2,28,2,27,2,4,2,26,2,6,2,25,2,2,16,12,11, 5,2,28,2,27,2,4,2,26,2,6,2,25,2,2,16,12,11,11,11,11,
11,11,11,11,11,11,11,11,11,11,11,16,12,2,11,2,9,2,29,2,10, 11,11,11,11,11,11,11,11,16,12,2,11,2,9,2,29,2,10,2,5,2,
2,5,2,28,2,27,2,4,2,26,2,6,2,25,2,2,48,48,37,11,11, 28,2,27,2,4,2,26,2,6,2,25,2,2,48,48,37,12,11,11,16,0,
16,0,16,0,16,0,36,36,11,11,11,16,0,16,0,16,0,36,36,16,0, 16,0,16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,28,20,
16,28,20,15,16,2,88,163,8,36,37,51,16,2,8,240,0,128,0,0,8, 15,16,2,88,163,8,36,37,51,16,2,8,240,0,128,0,0,8,240,1,128,
240,1,128,0,0,2,30,223,0,33,50,80,159,36,8,31,39,20,15,16,2, 0,0,2,30,223,0,33,50,80,159,36,8,31,39,20,15,16,2,88,163,8,
88,163,8,36,37,56,16,2,44,8,240,0,64,0,0,2,30,223,0,33,51, 36,37,56,16,2,44,8,240,0,64,0,0,2,30,223,0,33,51,80,159,36,
80,159,36,8,30,39,20,15,16,2,88,163,8,36,37,51,16,2,44,8,128, 8,30,39,20,15,16,2,88,163,8,36,37,51,16,2,44,8,128,128,2,30,
128,2,30,223,0,33,52,80,159,36,8,29,39,20,15,16,2,88,163,8,36, 223,0,33,52,80,159,36,8,29,39,20,15,16,2,88,163,8,36,37,51,16,
37,51,16,2,44,8,128,64,2,30,223,0,33,53,80,159,36,8,28,39,20, 2,44,8,128,64,2,30,223,0,33,53,80,159,36,8,28,39,20,15,16,2,
15,16,2,32,0,88,163,36,37,45,11,2,2,222,33,54,80,159,36,36,37, 32,0,88,163,36,37,45,11,2,2,222,33,54,80,159,36,36,37,20,15,16,
20,15,16,2,249,22,132,7,7,92,7,92,80,159,36,37,37,20,15,16,2, 2,249,22,132,7,7,92,7,92,80,159,36,37,37,20,15,16,2,88,163,36,
88,163,36,37,54,38,2,4,223,0,33,55,80,159,36,38,37,20,15,16,2, 37,54,38,2,4,223,0,33,55,80,159,36,38,37,20,15,16,2,20,25,96,
20,25,96,2,5,88,163,8,36,39,8,24,52,9,223,0,33,62,88,163,36, 2,5,88,163,8,36,39,8,24,52,9,223,0,33,62,88,163,36,38,47,44,
38,47,44,9,223,0,33,63,88,163,36,37,46,44,9,223,0,33,64,80,159, 9,223,0,33,63,88,163,36,37,46,44,9,223,0,33,64,80,159,36,39,37,
36,39,37,20,15,16,2,27,248,22,132,15,248,22,144,8,27,28,249,22,140, 20,15,16,2,27,248,22,132,15,248,22,144,8,27,28,249,22,140,9,247,22,
9,247,22,152,8,2,32,6,1,1,59,6,1,1,58,250,22,178,7,6,14, 152,8,2,32,6,1,1,59,6,1,1,58,250,22,178,7,6,14,14,40,91,
14,40,91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1, 94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1,88,163,8,
88,163,8,36,38,48,11,2,6,223,0,33,68,80,159,36,40,37,20,15,16, 36,38,48,11,2,6,223,0,33,68,80,159,36,40,37,20,15,16,2,32,0,
2,32,0,88,163,8,36,38,50,11,2,7,222,33,69,80,159,36,41,37,20, 88,163,8,36,38,50,11,2,7,222,33,69,80,159,36,41,37,20,15,16,2,
15,16,2,32,0,88,163,8,36,39,51,11,2,8,222,33,71,80,159,36,42, 32,0,88,163,8,36,39,51,11,2,8,222,33,71,80,159,36,42,37,20,15,
37,20,15,16,2,88,163,45,38,51,8,128,4,2,9,223,0,33,74,80,159, 16,2,88,163,45,38,51,8,128,4,2,9,223,0,33,74,80,159,36,43,37,
36,43,37,20,15,16,2,88,163,45,39,52,8,128,4,2,11,223,0,33,77, 20,15,16,2,88,163,45,39,52,8,128,4,2,11,223,0,33,77,80,159,36,
80,159,36,45,37,20,15,16,2,248,22,188,14,70,108,105,110,107,115,45,102, 45,37,20,15,16,2,248,22,188,14,70,108,105,110,107,115,45,102,105,108,101,
105,108,101,80,159,36,46,37,20,15,16,2,247,22,133,2,80,158,36,47,20, 80,159,36,46,37,20,15,16,2,247,22,133,2,80,158,36,47,20,15,16,2,
15,16,2,2,78,80,158,36,48,20,15,16,2,248,80,159,37,50,37,88,163, 2,78,80,158,36,48,20,15,16,2,248,80,159,37,50,37,88,163,36,36,49,
36,36,49,8,240,8,128,1,0,9,223,1,33,79,80,159,36,49,37,20,15, 8,240,8,128,1,0,9,223,1,33,79,80,159,36,49,37,20,15,16,2,247,
16,2,247,22,133,2,80,158,36,53,20,15,16,2,2,78,80,158,36,54,20, 22,133,2,80,158,36,53,20,15,16,2,2,78,80,158,36,54,20,15,16,2,
15,16,2,88,163,36,37,44,8,240,0,188,23,0,2,22,223,0,33,90,80, 88,163,36,37,44,8,240,0,188,23,0,2,22,223,0,33,90,80,159,36,55,
159,36,55,37,20,15,16,2,88,163,36,38,56,8,240,0,0,32,0,2,23, 37,20,15,16,2,88,163,36,38,56,8,240,0,0,32,0,2,23,223,0,33,
223,0,33,92,80,159,36,57,37,20,15,16,2,88,163,36,41,8,24,8,240, 92,80,159,36,57,37,20,15,16,2,88,163,36,41,8,24,8,240,0,32,40,
0,32,40,0,2,10,223,0,33,99,80,159,36,44,37,20,15,16,2,32,0, 0,2,10,223,0,33,99,80,159,36,44,37,20,15,16,2,32,0,88,163,36,
88,163,36,39,50,11,2,24,222,33,100,80,159,36,58,37,20,15,16,2,32, 39,50,11,2,24,222,33,100,80,159,36,58,37,20,15,16,2,32,0,88,163,
0,88,163,36,38,53,11,2,25,222,33,101,80,159,36,59,37,20,15,16,2, 36,38,53,11,2,25,222,33,101,80,159,36,59,37,20,15,16,2,32,0,88,
32,0,88,163,36,38,54,11,2,26,222,33,102,80,159,36,8,24,37,20,15, 163,36,38,54,11,2,26,222,33,102,80,159,36,8,24,37,20,15,16,2,32,
16,2,32,0,88,163,36,37,44,11,2,27,222,33,103,80,159,36,8,25,37, 0,88,163,36,37,44,11,2,27,222,33,103,80,159,36,8,25,37,20,15,16,
20,15,16,2,20,25,96,2,28,88,163,36,36,53,16,2,52,8,128,64,9, 2,20,25,96,2,28,88,163,36,36,53,16,2,52,8,128,64,9,223,0,33,
223,0,33,104,88,163,36,37,54,16,2,52,8,128,128,9,223,0,33,105,88, 104,88,163,36,37,54,16,2,52,8,128,128,9,223,0,33,105,88,163,36,38,
163,36,38,55,16,2,52,8,240,0,64,0,0,9,223,0,33,106,80,159,36, 55,16,2,52,8,240,0,64,0,0,9,223,0,33,106,80,159,36,8,26,37,
8,26,37,20,15,16,2,88,163,8,36,39,54,16,2,44,8,240,0,128,0, 20,15,16,2,88,163,8,36,39,54,16,2,44,8,240,0,128,0,0,2,29,
0,2,29,223,0,33,108,80,159,36,8,27,37,95,29,94,2,16,68,35,37, 223,0,33,108,80,159,36,8,27,37,95,29,94,2,16,68,35,37,107,101,114,
107,101,114,110,101,108,11,29,94,2,16,69,35,37,109,105,110,45,115,116,120, 110,101,108,11,29,94,2,16,69,35,37,109,105,110,45,115,116,120,11,2,18,
11,2,18,9,9,9,36,0}; 9,9,9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 10423); EVAL_ONE_SIZED_STR((char *)expr, 10420);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,57, 0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,57,
0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,178,1, 0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,175,1,
0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,116, 0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,116,
114,117,99,116,58,84,72,45,112,108,97,99,101,45,99,104,97,110,110,101,108, 114,117,99,116,58,84,72,45,112,108,97,99,101,45,99,104,97,110,110,101,108,
76,84,72,45,112,108,97,99,101,45,99,104,97,110,110,101,108,77,84,72,45, 76,84,72,45,112,108,97,99,101,45,99,104,97,110,110,101,108,77,84,72,45,
@ -610,29 +611,29 @@
112,108,97,99,101,45,99,104,97,110,110,101,108,45,105,110,1,20,84,72,45, 112,108,97,99,101,45,99,104,97,110,110,101,108,45,105,110,1,20,84,72,45,
112,108,97,99,101,45,99,104,97,110,110,101,108,45,111,117,116,249,80,158,38, 112,108,97,99,101,45,99,104,97,110,110,101,108,45,111,117,116,249,80,158,38,
39,195,36,249,80,158,38,39,195,36,249,80,158,38,39,195,37,159,36,20,112, 39,195,36,249,80,158,38,39,195,36,249,80,158,38,39,195,37,159,36,20,112,
159,36,16,1,11,16,0,20,26,142,2,1,2,1,29,11,11,11,11,11,10, 159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11,11,11,11,10,
45,80,158,36,36,20,112,159,36,16,7,2,2,2,3,2,4,2,5,2,6, 45,80,158,36,36,20,112,159,36,16,7,2,2,2,3,2,4,2,5,2,6,
2,7,2,8,16,0,16,0,36,16,0,36,16,2,2,5,2,6,38,11,11, 2,7,2,8,16,0,37,39,36,16,0,36,16,2,2,5,2,6,38,11,11,
39,36,11,11,16,5,2,3,2,7,2,8,2,4,2,2,16,5,11,11,11, 11,16,5,2,3,2,7,2,8,2,4,2,2,16,5,11,11,11,11,11,16,
11,11,16,5,2,3,2,7,2,8,2,4,2,2,41,41,37,11,11,16,0, 5,2,3,2,7,2,8,2,4,2,2,41,41,37,12,11,11,16,0,16,0,
16,0,16,0,36,36,11,11,11,16,0,16,0,16,0,36,36,16,0,16,2, 16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,2,20,15,16,
20,15,16,6,253,22,176,10,2,3,11,38,36,11,248,22,83,249,22,73,22, 6,253,22,176,10,2,3,11,38,36,11,248,22,83,249,22,73,22,164,10,88,
164,10,88,163,36,37,45,44,9,223,9,33,9,80,159,36,36,37,80,159,36, 163,36,37,45,44,9,223,9,33,9,80,159,36,36,37,80,159,36,37,37,80,
37,37,80,159,36,38,37,80,159,36,39,37,80,159,36,40,37,20,15,16,3, 159,36,38,37,80,159,36,39,37,80,159,36,40,37,20,15,16,3,249,22,7,
249,22,7,88,163,36,37,45,44,9,223,2,33,10,88,163,36,37,45,44,9, 88,163,36,37,45,44,9,223,2,33,10,88,163,36,37,45,44,9,223,2,33,
223,2,33,11,80,159,36,41,37,80,159,36,42,37,93,29,94,65,113,117,111, 11,80,159,36,41,37,80,159,36,42,37,93,29,94,65,113,117,111,116,101,68,
116,101,68,35,37,107,101,114,110,101,108,11,9,9,9,36,0}; 35,37,107,101,114,110,101,108,11,9,9,9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 499); EVAL_ONE_SIZED_STR((char *)expr, 496);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,65,0,0,0,1,0,0,7,0,18,0,45, 0,0,0,0,0,0,0,0,0,65,0,0,0,1,0,0,7,0,18,0,45,
0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185,0, 0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185,0,
201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,94, 201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,94,
1,99,1,104,1,109,1,118,1,123,1,127,1,135,1,144,1,152,1,213,1, 1,99,1,104,1,109,1,118,1,123,1,127,1,135,1,144,1,152,1,213,1,
60,2,81,2,102,2,132,2,162,2,220,2,22,3,71,3,120,3,54,9,105, 60,2,81,2,102,2,132,2,162,2,220,2,22,3,71,3,120,3,54,9,105,
9,168,9,187,9,201,9,103,10,116,10,250,10,36,12,159,12,165,12,179,12, 9,168,9,187,9,201,9,103,10,116,10,250,10,36,12,159,12,165,12,179,12,
206,12,226,12,30,13,117,13,119,13,188,13,16,20,69,20,93,20,0,0,185, 206,12,226,12,30,13,117,13,119,13,188,13,16,20,69,20,93,20,0,0,182,
23,0,0,66,35,37,98,111,111,116,70,100,108,108,45,115,117,102,102,105,120, 23,0,0,66,35,37,98,111,111,116,70,100,108,108,45,115,117,102,102,105,120,
1,25,100,101,102,97,117,108,116,45,108,111,97,100,47,117,115,101,45,99,111, 1,25,100,101,102,97,117,108,116,45,108,111,97,100,47,117,115,101,45,99,111,
109,112,105,108,101,100,65,113,117,111,116,101,29,94,2,4,67,35,37,117,116, 109,112,105,108,101,100,65,113,117,111,116,101,29,94,2,4,67,35,37,117,116,
@ -882,7 +883,7 @@
22,178,4,80,159,37,54,38,248,22,158,5,80,159,37,37,39,248,22,181,13, 22,178,4,80,159,37,54,38,248,22,158,5,80,159,37,37,39,248,22,181,13,
80,159,37,42,39,20,18,159,11,80,158,36,53,248,80,159,37,8,25,37,249, 80,159,37,42,39,20,18,159,11,80,158,36,53,248,80,159,37,8,25,37,249,
22,27,11,80,159,39,55,37,159,36,20,112,159,36,16,1,11,16,0,20,26, 22,27,11,80,159,39,55,37,159,36,20,112,159,36,16,1,11,16,0,20,26,
142,2,1,2,1,29,11,11,11,11,11,10,38,80,158,36,36,20,112,159,40, 141,2,1,2,1,29,11,11,11,11,11,10,38,80,158,36,36,20,112,159,40,
16,26,2,2,2,3,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103, 16,26,2,2,2,3,30,2,5,72,112,97,116,104,45,115,116,114,105,110,103,
63,11,30,2,5,75,112,97,116,104,45,97,100,100,45,115,117,102,102,105,120, 63,11,30,2,5,75,112,97,116,104,45,97,100,100,45,115,117,102,102,105,120,
8,30,2,7,2,8,6,30,2,7,1,23,101,120,116,101,110,100,45,112,97, 8,30,2,7,2,8,6,30,2,7,1,23,101,120,116,101,110,100,45,112,97,
@ -892,59 +893,59 @@
45,115,117,102,102,105,120,10,30,2,5,73,102,105,110,100,45,99,111,108,45, 45,115,117,102,102,105,120,10,30,2,5,73,102,105,110,100,45,99,111,108,45,
102,105,108,101,3,30,2,5,76,110,111,114,109,97,108,45,99,97,115,101,45, 102,105,108,101,3,30,2,5,76,110,111,114,109,97,108,45,99,97,115,101,45,
112,97,116,104,7,2,23,2,24,30,2,22,74,114,101,112,97,114,97,109,101, 112,97,116,104,7,2,23,2,24,30,2,22,74,114,101,112,97,114,97,109,101,
116,101,114,105,122,101,7,16,0,16,0,36,16,0,36,16,14,2,15,2,16, 116,101,114,105,122,101,7,16,0,37,39,36,16,0,36,16,14,2,15,2,16,
2,10,2,12,2,17,2,18,2,11,2,3,2,9,2,2,2,13,2,14,2, 2,10,2,12,2,17,2,18,2,11,2,3,2,9,2,2,2,13,2,14,2,
19,2,21,50,11,11,39,36,11,11,16,3,2,23,2,20,2,24,16,3,11, 19,2,21,50,11,11,11,16,3,2,23,2,20,2,24,16,3,11,11,11,16,
11,11,16,3,2,23,2,20,2,24,39,39,37,11,11,16,0,16,0,16,0, 3,2,23,2,20,2,24,39,39,37,12,11,11,16,0,16,0,16,0,36,36,
36,36,11,11,11,16,0,16,0,16,0,36,36,16,0,16,21,20,15,16,2, 11,12,11,11,16,0,16,0,16,0,36,36,16,21,20,15,16,2,88,163,36,
88,163,36,37,45,8,128,128,9,223,0,33,32,80,159,36,8,29,39,20,15, 37,45,8,128,128,9,223,0,33,32,80,159,36,8,29,39,20,15,16,2,88,
16,2,88,163,8,36,37,45,8,240,0,0,1,0,9,223,0,33,33,80,159, 163,8,36,37,45,8,240,0,0,1,0,9,223,0,33,33,80,159,36,8,28,
36,8,28,39,20,15,16,2,88,163,36,37,49,8,240,0,0,16,0,72,112, 39,20,15,16,2,88,163,36,37,49,8,240,0,0,16,0,72,112,97,116,104,
97,116,104,45,115,115,45,62,114,107,116,223,0,33,34,80,159,36,8,27,39, 45,115,115,45,62,114,107,116,223,0,33,34,80,159,36,8,27,39,20,15,16,
20,15,16,2,88,163,36,37,49,8,240,0,192,0,0,67,103,101,116,45,100, 2,88,163,36,37,49,8,240,0,192,0,0,67,103,101,116,45,100,105,114,223,
105,114,223,0,33,35,80,159,36,8,26,39,20,15,16,2,248,22,152,8,69, 0,33,35,80,159,36,8,26,39,20,15,16,2,248,22,152,8,69,115,111,45,
115,111,45,115,117,102,102,105,120,80,159,36,36,37,20,15,16,2,88,163,36, 115,117,102,102,105,120,80,159,36,36,37,20,15,16,2,88,163,36,38,8,38,
38,8,38,8,61,2,3,223,0,33,44,80,159,36,37,37,20,15,16,2,32, 8,61,2,3,223,0,33,44,80,159,36,37,37,20,15,16,2,32,0,88,163,
0,88,163,8,36,37,42,11,2,9,222,192,80,159,36,42,37,20,15,16,2, 8,36,37,42,11,2,9,222,192,80,159,36,42,37,20,15,16,2,247,22,136,
247,22,136,2,80,159,36,43,37,20,15,16,2,8,128,8,80,159,36,44,37, 2,80,159,36,43,37,20,15,16,2,8,128,8,80,159,36,44,37,20,15,16,
20,15,16,2,249,22,156,8,8,128,8,11,80,159,36,45,37,20,15,16,2, 2,249,22,156,8,8,128,8,11,80,159,36,45,37,20,15,16,2,88,163,8,
88,163,8,36,37,50,8,128,8,2,13,223,0,33,45,80,159,36,46,37,20, 36,37,50,8,128,8,2,13,223,0,33,45,80,159,36,46,37,20,15,16,2,
15,16,2,88,163,8,36,38,55,8,128,8,2,14,223,0,33,46,80,159,36, 88,163,8,36,38,55,8,128,8,2,14,223,0,33,46,80,159,36,47,37,20,
47,37,20,15,16,2,247,22,69,80,159,36,48,37,20,15,16,2,248,22,18, 15,16,2,247,22,69,80,159,36,48,37,20,15,16,2,248,22,18,74,109,111,
74,109,111,100,117,108,101,45,108,111,97,100,105,110,103,80,159,36,49,37,20, 100,117,108,101,45,108,111,97,100,105,110,103,80,159,36,49,37,20,15,16,2,
15,16,2,11,80,158,36,50,20,15,16,2,11,80,158,36,51,20,15,16,2, 11,80,158,36,50,20,15,16,2,11,80,158,36,51,20,15,16,2,32,0,88,
32,0,88,163,36,38,8,25,11,2,19,222,33,52,80,159,36,52,37,20,15, 163,36,38,8,25,11,2,19,222,33,52,80,159,36,52,37,20,15,16,2,11,
16,2,11,80,158,36,53,20,15,16,2,27,11,20,19,158,36,90,159,37,10, 80,158,36,53,20,15,16,2,27,11,20,19,158,36,90,159,37,10,89,161,37,
89,161,37,36,10,20,25,96,2,21,88,163,8,36,37,51,8,128,2,9,224, 36,10,20,25,96,2,21,88,163,8,36,37,51,8,128,2,9,224,2,1,33,
2,1,33,53,88,163,36,39,49,11,9,223,0,33,54,88,163,36,40,8,38, 53,88,163,36,39,49,11,9,223,0,33,54,88,163,36,40,8,38,16,2,8,
16,2,8,176,218,8,187,241,9,224,2,1,33,62,207,80,159,36,54,37,20, 176,218,8,187,241,9,224,2,1,33,62,207,80,159,36,54,37,20,15,16,2,
15,16,2,88,163,36,36,45,8,240,66,0,14,2,2,23,223,0,33,63,80, 88,163,36,36,45,8,240,66,0,14,2,2,23,223,0,33,63,80,159,36,59,
159,36,59,37,20,15,16,2,88,163,8,36,36,45,8,240,0,0,10,2,2, 37,20,15,16,2,88,163,8,36,36,45,8,240,0,0,10,2,2,24,223,0,
24,223,0,33,64,80,159,36,8,24,37,96,29,94,2,4,68,35,37,107,101, 33,64,80,159,36,8,24,37,96,29,94,2,4,68,35,37,107,101,114,110,101,
114,110,101,108,11,29,94,2,4,69,35,37,109,105,110,45,115,116,120,11,2, 108,11,29,94,2,4,69,35,37,109,105,110,45,115,116,120,11,2,5,2,22,
5,2,22,9,9,9,36,0}; 9,9,9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 6244); EVAL_ONE_SIZED_STR((char *)expr, 6241);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,54,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,29, 0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,29,
0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,97,1,0,0, 0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,94,1,0,0,
69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67, 69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67,
35,37,117,116,105,108,115,11,29,94,2,2,69,35,37,110,101,116,119,111,114, 35,37,117,116,105,108,115,11,29,94,2,2,69,35,37,110,101,116,119,111,114,
107,11,29,94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2,74, 107,11,29,94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2,74,
35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,2,66,35, 35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,2,66,35,
37,98,111,111,116,11,29,94,2,2,68,35,37,101,120,112,111,98,115,11,29, 37,98,111,111,116,11,29,94,2,2,68,35,37,101,120,112,111,98,115,11,29,
94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,56,78,0, 94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,11,78,0,
0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6,36, 0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6,36,
36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36,36, 36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36,36,
16,0,159,36,20,112,159,36,16,1,11,16,0,20,26,142,2,1,2,1,29, 16,0,159,36,20,112,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,
11,11,11,11,11,18,96,11,46,46,46,36,80,158,36,36,20,112,159,36,16, 11,11,11,11,11,18,96,11,46,46,46,36,80,158,36,36,20,112,159,36,16,
0,16,0,16,0,36,16,0,36,16,0,36,11,11,39,36,11,11,16,0,16, 0,16,0,37,39,36,16,0,36,16,0,36,11,11,11,16,0,16,0,16,0,
0,16,0,36,36,37,11,11,16,0,16,0,16,0,36,36,11,11,11,16,0, 36,36,37,12,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0,16,
16,0,16,0,36,36,16,0,16,0,104,2,9,2,8,29,94,2,2,69,35, 0,16,0,36,36,16,0,104,2,9,2,8,29,94,2,2,69,35,37,102,111,
37,102,111,114,101,105,103,110,11,29,94,2,2,68,35,37,117,110,115,97,102, 114,101,105,103,110,11,29,94,2,2,68,35,37,117,110,115,97,102,101,11,29,
101,11,29,94,2,2,69,35,37,102,108,102,120,110,117,109,11,2,7,2,6, 94,2,2,69,35,37,102,108,102,120,110,117,109,11,2,7,2,6,2,5,2,
2,5,2,4,2,3,29,94,2,2,67,35,37,112,108,97,99,101,11,29,94, 4,2,3,29,94,2,2,67,35,37,112,108,97,99,101,11,29,94,2,2,69,
2,2,69,35,37,102,117,116,117,114,101,115,11,9,9,9,36,0}; 35,37,102,117,116,117,114,101,115,11,9,9,9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 416); EVAL_ONE_SIZED_STR((char *)expr, 413);
} }

42
src/racket/src/env.c
View File

@ -502,20 +502,22 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
return env; return env;
} }
#ifdef MZ_USE_PLACES
Scheme_Env *scheme_place_instance_init(void *stack_base, struct NewGC *parent_gc, intptr_t memory_limit) { Scheme_Env *scheme_place_instance_init(void *stack_base, struct NewGC *parent_gc, intptr_t memory_limit) {
Scheme_Env *env; Scheme_Env *env;
#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES) # if defined(MZ_PRECISE_GC)
int *signal_fd; int *signal_fd;
GC_construct_child_gc(parent_gc, memory_limit); GC_construct_child_gc(parent_gc, memory_limit);
#endif # endif
env = place_instance_init(stack_base, 0); env = place_instance_init(stack_base, 0);
#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES) # if defined(MZ_PRECISE_GC)
signal_fd = scheme_get_signal_handle(); signal_fd = scheme_get_signal_handle();
GC_set_put_external_event_fd(signal_fd); GC_set_put_external_event_fd(signal_fd);
#endif # endif
scheme_set_can_break(1); scheme_set_can_break(1);
return env; return env;
} }
#endif
static void force_more_closed(Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data) static void force_more_closed(Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data)
{ {
@ -835,6 +837,7 @@ scheme_new_module_env(Scheme_Env *env, Scheme_Module *m, int new_exp_module_tree
scheme_prepare_label_env(env); scheme_prepare_label_env(env);
menv->label_env = env->label_env; menv->label_env = env->label_env;
menv->instance_env = env;
if (new_exp_module_tree) { if (new_exp_module_tree) {
Scheme_Object *p; Scheme_Object *p;
@ -886,6 +889,7 @@ void scheme_prepare_exp_env(Scheme_Env *env)
env->exp_env = eenv; env->exp_env = eenv;
eenv->template_env = env; eenv->template_env = env;
eenv->label_env = env->label_env; eenv->label_env = env->label_env;
eenv->instance_env = env->instance_env;
scheme_prepare_env_renames(env, mzMOD_RENAME_TOPLEVEL); scheme_prepare_env_renames(env, mzMOD_RENAME_TOPLEVEL);
eenv->rename_set = env->rename_set; eenv->rename_set = env->rename_set;
@ -929,6 +933,7 @@ void scheme_prepare_template_env(Scheme_Env *env)
env->template_env = eenv; env->template_env = eenv;
eenv->exp_env = env; eenv->exp_env = env;
eenv->label_env = env->label_env; eenv->label_env = env->label_env;
eenv->instance_env = env->instance_env;
if (env->disallow_unbound) if (env->disallow_unbound)
eenv->disallow_unbound = env->disallow_unbound; eenv->disallow_unbound = env->disallow_unbound;
@ -962,6 +967,7 @@ void scheme_prepare_label_env(Scheme_Env *env)
lenv->exp_env = lenv; lenv->exp_env = lenv;
lenv->label_env = lenv; lenv->label_env = lenv;
lenv->template_env = lenv; lenv->template_env = lenv;
lenv->instance_env = env->instance_env;
} }
} }
@ -981,7 +987,9 @@ Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obje
menv2->module_registry = ns->module_registry; menv2->module_registry = ns->module_registry;
menv2->insp = menv->insp; menv2->insp = menv->insp;
if (menv->phase < clone_phase) menv2->instance_env = menv2;
if (menv->phase < clone_phase)
menv2->syntax = menv->syntax; menv2->syntax = menv->syntax;
else { else {
bucket_table = scheme_make_bucket_table(7, SCHEME_hash_ptr); bucket_table = scheme_make_bucket_table(7, SCHEME_hash_ptr);
@ -992,11 +1000,21 @@ Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obje
menv2->mod_phase = menv->mod_phase; menv2->mod_phase = menv->mod_phase;
menv2->link_midx = menv->link_midx; menv2->link_midx = menv->link_midx;
if (menv->phase <= clone_phase) { if (menv->phase <= clone_phase) {
menv2->running = menv->running;
menv2->ran = menv->ran; menv2->ran = menv->ran;
} }
if (menv->phase < clone_phase) if (menv->mod_phase == 0) {
menv2->et_running = menv->et_running; char *running;
int amt;
running = (char *)scheme_malloc_atomic(menv->module->num_phases);
menv2->running = running;
memset(running, 0, menv->module->num_phases);
amt = (clone_phase - menv->phase) + 1;
if (amt > 0) {
if (amt > menv->module->num_phases)
amt = menv->module->num_phases;
memcpy(running, menv->running, amt);
}
}
menv2->require_names = menv->require_names; menv2->require_names = menv->require_names;
menv2->et_require_names = menv->et_require_names; menv2->et_require_names = menv->et_require_names;
@ -2299,18 +2317,12 @@ local_module_exports(int argc, Scheme_Object *argv[])
static Scheme_Object * static Scheme_Object *
local_module_definitions(int argc, Scheme_Object *argv[]) local_module_definitions(int argc, Scheme_Object *argv[])
{ {
Scheme_Object *a[2];
if (!scheme_current_thread->current_local_env if (!scheme_current_thread->current_local_env
|| !scheme_current_thread->current_local_bindings) || !scheme_current_thread->current_local_bindings)
scheme_raise_exn(MZEXN_FAIL_CONTRACT, scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"syntax-local-module-defined-identifiers: not currently transforming module provides"); "syntax-local-module-defined-identifiers: not currently transforming module provides");
a[0] = SCHEME_CDR(scheme_current_thread->current_local_bindings); return SCHEME_CDR(scheme_current_thread->current_local_bindings);
a[1] = SCHEME_CDR(a[0]);
a[0] = SCHEME_CAR(a[0]);
return scheme_values(2, a);
} }
static Scheme_Object * static Scheme_Object *

49
src/racket/src/eval.c
View File

@ -1669,10 +1669,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
save_runstack = scheme_push_prefix(dm_env->exp_env, rp, NULL, NULL, 1, 1, NULL, scheme_false); save_runstack = scheme_push_prefix(dm_env->exp_env, rp, NULL, NULL, 1, 1, NULL, scheme_false);
vals = scheme_eval_linked_expr_multi_with_dynamic_state(vals_expr, dyn_state); vals = scheme_eval_linked_expr_multi_with_dynamic_state(vals_expr, dyn_state);
if (defmacro == 2) scheme_pop_prefix(save_runstack);
dm_env = NULL;
else
scheme_pop_prefix(save_runstack);
} else { } else {
vals = _scheme_eval_linked_expr_multi(vals_expr); vals = _scheme_eval_linked_expr_multi(vals_expr);
dm_env = NULL; dm_env = NULL;
@ -1782,16 +1779,13 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
} else } else
name = NULL; name = NULL;
if (defmacro > 1)
scheme_pop_prefix(save_runstack);
{ {
const char *symname; const char *symname;
symname = (show_any ? scheme_symbol_name(name) : ""); symname = (show_any ? scheme_symbol_name(name) : "");
scheme_wrong_return_arity((defmacro scheme_wrong_return_arity((defmacro
? (dm_env ? "define-syntaxes" : "define-values-for-syntax") ? "define-syntaxes"
: "define-values"), : "define-values"),
i, g, i, g,
(g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array, (g == 1) ? (Scheme_Object **)vals : scheme_current_thread->ku.multiple.array,
@ -2034,7 +2028,7 @@ static Scheme_Object *splice_execute(Scheme_Object *data)
} }
} }
static Scheme_Object *do_define_syntaxes_execute(Scheme_Object *expr, Scheme_Env *dm_env, int for_stx); static Scheme_Object *do_define_syntaxes_execute(Scheme_Object *expr, Scheme_Env *dm_env);
static void *define_syntaxes_execute_k(void) static void *define_syntaxes_execute_k(void)
{ {
@ -2043,11 +2037,11 @@ static void *define_syntaxes_execute_k(void)
Scheme_Env *dm_env = (Scheme_Env *)p->ku.k.p2; Scheme_Env *dm_env = (Scheme_Env *)p->ku.k.p2;
p->ku.k.p1 = NULL; p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL; p->ku.k.p2 = NULL;
return do_define_syntaxes_execute(form, dm_env, p->ku.k.i1); return do_define_syntaxes_execute(form, dm_env);
} }
static Scheme_Object * static Scheme_Object *
do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env, int for_stx) do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env)
{ {
Scheme_Thread *p = scheme_current_thread; Scheme_Thread *p = scheme_current_thread;
Resolve_Prefix *rp; Resolve_Prefix *rp;
@ -2068,7 +2062,6 @@ do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env, int for_stx)
dm_env = scheme_environment_from_dummy(dummy); dm_env = scheme_environment_from_dummy(dummy);
} }
p->ku.k.p2 = (Scheme_Object *)dm_env; p->ku.k.p2 = (Scheme_Object *)dm_env;
p->ku.k.i1 = for_stx;
return (Scheme_Object *)scheme_enlarge_runstack(depth, define_syntaxes_execute_k); return (Scheme_Object *)scheme_enlarge_runstack(depth, define_syntaxes_execute_k);
} }
@ -2095,24 +2088,40 @@ do_define_syntaxes_execute(Scheme_Object *form, Scheme_Env *dm_env, int for_stx)
scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config); scheme_set_cont_mark(scheme_parameterization_key, (Scheme_Object *)config);
scheme_set_dynamic_state(&dyn_state, rhs_env, NULL, scheme_false, dm_env, dm_env->link_midx); scheme_set_dynamic_state(&dyn_state, rhs_env, NULL, scheme_false, dm_env, dm_env->link_midx);
result = define_execute_with_dynamic_state(form, 4, for_stx ? 2 : 1, rp, dm_env, &dyn_state);
if (SAME_TYPE(SCHEME_TYPE(form), scheme_define_syntaxes_type)) {
result = define_execute_with_dynamic_state(form, 4, 1, rp, dm_env, &dyn_state);
} else {
Scheme_Object **save_runstack;
form = SCHEME_VEC_ELS(form)[0];
save_runstack = scheme_push_prefix(dm_env->exp_env, rp, NULL, NULL, 1, 1, NULL, scheme_false);
while (!SCHEME_NULLP(form)) {
(void)scheme_eval_linked_expr_multi_with_dynamic_state(SCHEME_CAR(form), &dyn_state);
form = SCHEME_CDR(form);
}
scheme_pop_prefix(save_runstack);
}
scheme_pop_continuation_frame(&cframe); scheme_pop_continuation_frame(&cframe);
return result; return scheme_void;
} }
} }
static Scheme_Object * static Scheme_Object *
define_syntaxes_execute(Scheme_Object *form) define_syntaxes_execute(Scheme_Object *form)
{ {
return do_define_syntaxes_execute(form, NULL, 0); return do_define_syntaxes_execute(form, NULL);
} }
static Scheme_Object * static Scheme_Object *
define_for_syntaxes_execute(Scheme_Object *form) begin_for_syntax_execute(Scheme_Object *form)
{ {
return do_define_syntaxes_execute(form, NULL, 1); return do_define_syntaxes_execute(form, NULL);
} }
/*========================================================================*/ /*========================================================================*/
@ -3444,10 +3453,10 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
v = define_syntaxes_execute(obj); v = define_syntaxes_execute(obj);
break; break;
} }
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
{ {
UPDATE_THREAD_RSPTR(); UPDATE_THREAD_RSPTR();
v = define_for_syntaxes_execute(obj); v = begin_for_syntax_execute(obj);
break; break;
} }
case scheme_set_bang_type: case scheme_set_bang_type:
@ -5179,7 +5188,7 @@ Scheme_Object *scheme_eval_clone(Scheme_Object *expr)
return scheme_module_eval_clone(expr); return scheme_module_eval_clone(expr);
break; break;
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
return scheme_syntaxes_eval_clone(expr); return scheme_syntaxes_eval_clone(expr);
default: default:
return expr; return expr;

27
src/racket/src/fun.c
View File

@ -119,7 +119,7 @@ THREAD_LOCAL_DECL(static Scheme_Object *cached_mod_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_mod_beg_stx); THREAD_LOCAL_DECL(static Scheme_Object *cached_mod_beg_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_dv_stx); THREAD_LOCAL_DECL(static Scheme_Object *cached_dv_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_ds_stx); THREAD_LOCAL_DECL(static Scheme_Object *cached_ds_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_dvs_stx); THREAD_LOCAL_DECL(static Scheme_Object *cached_bfs_stx);
THREAD_LOCAL_DECL(static int cached_stx_phase); THREAD_LOCAL_DECL(static int cached_stx_phase);
THREAD_LOCAL_DECL(static Scheme_Cont *offstack_cont); THREAD_LOCAL_DECL(static Scheme_Cont *offstack_cont);
THREAD_LOCAL_DECL(static Scheme_Overflow *offstack_overflow); THREAD_LOCAL_DECL(static Scheme_Overflow *offstack_overflow);
@ -624,7 +624,7 @@ scheme_init_fun_places()
REGISTER_SO(cached_mod_beg_stx); REGISTER_SO(cached_mod_beg_stx);
REGISTER_SO(cached_dv_stx); REGISTER_SO(cached_dv_stx);
REGISTER_SO(cached_ds_stx); REGISTER_SO(cached_ds_stx);
REGISTER_SO(cached_dvs_stx); REGISTER_SO(cached_bfs_stx);
REGISTER_SO(offstack_cont); REGISTER_SO(offstack_cont);
REGISTER_SO(offstack_overflow); REGISTER_SO(offstack_overflow);
} }
@ -1550,7 +1550,7 @@ cert_with_specials(Scheme_Object *code,
/* Arms (insp) or re-arms (old_stx) taints. */ /* Arms (insp) or re-arms (old_stx) taints. */
{ {
Scheme_Object *prop; Scheme_Object *prop;
int next_cadr_deflt = 0; int next_cadr_deflt = 0, phase_delta = 0;
#ifdef DO_STACK_CHECK #ifdef DO_STACK_CHECK
{ {
@ -1609,7 +1609,7 @@ cert_with_specials(Scheme_Object *code,
name = scheme_stx_taint_disarm(code, NULL); name = scheme_stx_taint_disarm(code, NULL);
name = SCHEME_STX_CAR(name); name = SCHEME_STX_CAR(name);
if (SCHEME_STX_SYMBOLP(name)) { if (SCHEME_STX_SYMBOLP(name)) {
Scheme_Object *beg_stx, *mod_stx, *mod_beg_stx, *dv_stx, *ds_stx, *dvs_stx; Scheme_Object *beg_stx, *mod_stx, *mod_beg_stx, *dv_stx, *ds_stx, *bfs_stx;
if (!phase) { if (!phase) {
mod_stx = scheme_module_stx; mod_stx = scheme_module_stx;
@ -1617,14 +1617,14 @@ cert_with_specials(Scheme_Object *code,
mod_beg_stx = scheme_module_begin_stx; mod_beg_stx = scheme_module_begin_stx;
dv_stx = scheme_define_values_stx; dv_stx = scheme_define_values_stx;
ds_stx = scheme_define_syntaxes_stx; ds_stx = scheme_define_syntaxes_stx;
dvs_stx = scheme_define_for_syntaxes_stx; bfs_stx = scheme_begin_for_syntax_stx;
} else if (phase == cached_stx_phase) { } else if (phase == cached_stx_phase) {
beg_stx = cached_beg_stx; beg_stx = cached_beg_stx;
mod_stx = cached_mod_stx; mod_stx = cached_mod_stx;
mod_beg_stx = cached_mod_beg_stx; mod_beg_stx = cached_mod_beg_stx;
dv_stx = cached_dv_stx; dv_stx = cached_dv_stx;
ds_stx = cached_ds_stx; ds_stx = cached_ds_stx;
dvs_stx = cached_dvs_stx; bfs_stx = cached_bfs_stx;
} else { } else {
Scheme_Object *sr; Scheme_Object *sr;
sr = scheme_sys_wraps_phase(scheme_make_integer(phase)); sr = scheme_sys_wraps_phase(scheme_make_integer(phase));
@ -1638,14 +1638,14 @@ cert_with_specials(Scheme_Object *code,
sr, 0, 0); sr, 0, 0);
ds_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_define_syntaxes_stx), scheme_false, ds_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_define_syntaxes_stx), scheme_false,
sr, 0, 0); sr, 0, 0);
dvs_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_define_for_syntaxes_stx), scheme_false, bfs_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_begin_for_syntax_stx), scheme_false,
sr, 0, 0); sr, 0, 0);
cached_beg_stx = beg_stx; cached_beg_stx = beg_stx;
cached_mod_stx = mod_stx; cached_mod_stx = mod_stx;
cached_mod_beg_stx = mod_beg_stx; cached_mod_beg_stx = mod_beg_stx;
cached_dv_stx = dv_stx; cached_dv_stx = dv_stx;
cached_ds_stx = ds_stx; cached_ds_stx = ds_stx;
cached_dvs_stx = dvs_stx; cached_bfs_stx = bfs_stx;
cached_stx_phase = phase; cached_stx_phase = phase;
} }
@ -1654,9 +1654,12 @@ cert_with_specials(Scheme_Object *code,
|| scheme_stx_module_eq(mod_beg_stx, name, phase)) { || scheme_stx_module_eq(mod_beg_stx, name, phase)) {
trans = 1; trans = 1;
next_cadr_deflt = 0; next_cadr_deflt = 0;
} else if (scheme_stx_module_eq(bfs_stx, name, phase)) {
trans = 1;
next_cadr_deflt = 0;
phase_delta = 1;
} else if (scheme_stx_module_eq(dv_stx, name, phase) } else if (scheme_stx_module_eq(dv_stx, name, phase)
|| scheme_stx_module_eq(ds_stx, name, phase) || scheme_stx_module_eq(ds_stx, name, phase)) {
|| scheme_stx_module_eq(dvs_stx, name, phase)) {
trans = 1; trans = 1;
next_cadr_deflt = 1; next_cadr_deflt = 1;
} }
@ -1676,9 +1679,9 @@ cert_with_specials(Scheme_Object *code,
Scheme_Object *a, *d, *v; Scheme_Object *a, *d, *v;
a = SCHEME_STX_CAR(code); a = SCHEME_STX_CAR(code);
a = cert_with_specials(a, insp, old_stx, phase, cadr_deflt, 0); a = cert_with_specials(a, insp, old_stx, phase + phase_delta, cadr_deflt, 0);
d = SCHEME_STX_CDR(code); d = SCHEME_STX_CDR(code);
d = cert_with_specials(d, insp, old_stx, phase, 1, next_cadr_deflt); d = cert_with_specials(d, insp, old_stx, phase + phase_delta, 1, next_cadr_deflt);
v = scheme_make_pair(a, d); v = scheme_make_pair(a, d);

2
src/racket/src/jit.c
View File

@ -2364,7 +2364,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
case scheme_splice_sequence_type: case scheme_splice_sequence_type:
case scheme_define_values_type: case scheme_define_values_type:
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
case scheme_require_form_type: case scheme_require_form_type:
case scheme_module_type: case scheme_module_type:
{ {

29
src/racket/src/jitprep.c
View File

@ -483,7 +483,7 @@ static Scheme_Object *define_syntaxes_jit(Scheme_Object *expr)
return do_define_syntaxes_clone(expr, 1); return do_define_syntaxes_clone(expr, 1);
} }
static Scheme_Object *define_for_syntaxes_jit(Scheme_Object *expr) static Scheme_Object *begin_for_syntax_jit(Scheme_Object *expr)
{ {
return do_define_syntaxes_clone(expr, 1); return do_define_syntaxes_clone(expr, 1);
} }
@ -583,8 +583,8 @@ Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
return define_values_jit(expr); return define_values_jit(expr);
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
return define_syntaxes_jit(expr); return define_syntaxes_jit(expr);
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
return define_for_syntaxes_jit(expr); return begin_for_syntax_jit(expr);
case scheme_set_bang_type: case scheme_set_bang_type:
return set_jit(expr); return set_jit(expr);
case scheme_boxenv_type: case scheme_boxenv_type:
@ -622,9 +622,26 @@ static Scheme_Object *do_define_syntaxes_clone(Scheme_Object *expr, int jit)
rhs = SCHEME_VEC_ELS(expr)[0]; rhs = SCHEME_VEC_ELS(expr)[0];
#ifdef MZ_USE_JIT #ifdef MZ_USE_JIT
if (jit) if (jit) {
naya = scheme_jit_expr(rhs); if (SAME_TYPE(SCHEME_TYPE(expr), scheme_define_syntaxes_type))
else naya = scheme_jit_expr(rhs);
else {
int changed = 0;
Scheme_Object *a, *l = rhs;
naya = scheme_null;
while (!SCHEME_NULLP(l)) {
a = scheme_jit_expr(SCHEME_CAR(l));
if (!SAME_OBJ(a, SCHEME_CAR(l)))
changed = 1;
naya = scheme_make_pair(a, naya);
l = SCHEME_CDR(l);
}
if (changed)
naya = scheme_reverse(naya);
else
naya = rhs;
}
} else
#endif #endif
naya = rhs; naya = rhs;

347
src/racket/src/marshal.c
View File

@ -45,8 +45,8 @@ static Scheme_Object *read_define_values(Scheme_Object *obj);
static Scheme_Object *write_define_values(Scheme_Object *obj); static Scheme_Object *write_define_values(Scheme_Object *obj);
static Scheme_Object *read_define_syntaxes(Scheme_Object *obj); static Scheme_Object *read_define_syntaxes(Scheme_Object *obj);
static Scheme_Object *write_define_syntaxes(Scheme_Object *obj); static Scheme_Object *write_define_syntaxes(Scheme_Object *obj);
static Scheme_Object *read_define_for_syntax(Scheme_Object *obj); static Scheme_Object *read_begin_for_syntax(Scheme_Object *obj);
static Scheme_Object *write_define_for_syntax(Scheme_Object *obj); static Scheme_Object *write_begin_for_syntax(Scheme_Object *obj);
static Scheme_Object *read_set_bang(Scheme_Object *obj); static Scheme_Object *read_set_bang(Scheme_Object *obj);
static Scheme_Object *write_set_bang(Scheme_Object *obj); static Scheme_Object *write_set_bang(Scheme_Object *obj);
static Scheme_Object *read_boxenv(Scheme_Object *obj); static Scheme_Object *read_boxenv(Scheme_Object *obj);
@ -125,8 +125,8 @@ void scheme_init_marshal(Scheme_Env *env)
scheme_install_type_reader(scheme_define_values_type, read_define_values); scheme_install_type_reader(scheme_define_values_type, read_define_values);
scheme_install_type_writer(scheme_define_syntaxes_type, write_define_syntaxes); scheme_install_type_writer(scheme_define_syntaxes_type, write_define_syntaxes);
scheme_install_type_reader(scheme_define_syntaxes_type, read_define_syntaxes); scheme_install_type_reader(scheme_define_syntaxes_type, read_define_syntaxes);
scheme_install_type_writer(scheme_define_for_syntax_type, write_define_for_syntax); scheme_install_type_writer(scheme_begin_for_syntax_type, write_begin_for_syntax);
scheme_install_type_reader(scheme_define_for_syntax_type, read_define_for_syntax); scheme_install_type_reader(scheme_begin_for_syntax_type, read_begin_for_syntax);
scheme_install_type_writer(scheme_set_bang_type, write_set_bang); scheme_install_type_writer(scheme_set_bang_type, write_set_bang);
scheme_install_type_reader(scheme_set_bang_type, read_set_bang); scheme_install_type_reader(scheme_set_bang_type, read_set_bang);
scheme_install_type_writer(scheme_boxenv_type, write_boxenv); scheme_install_type_writer(scheme_boxenv_type, write_boxenv);
@ -407,16 +407,16 @@ static Scheme_Object *write_define_syntaxes(Scheme_Object *obj)
return write_define_values(obj); return write_define_values(obj);
} }
static Scheme_Object *read_define_for_syntax(Scheme_Object *obj) static Scheme_Object *read_begin_for_syntax(Scheme_Object *obj)
{ {
if (!SCHEME_VECTORP(obj)) return NULL; if (!SCHEME_VECTORP(obj)) return NULL;
obj = scheme_clone_vector(obj, 0, 0); obj = scheme_clone_vector(obj, 0, 0);
obj->type = scheme_define_for_syntax_type; obj->type = scheme_begin_for_syntax_type;
return obj; return obj;
} }
static Scheme_Object *write_define_for_syntax(Scheme_Object *obj) static Scheme_Object *write_begin_for_syntax(Scheme_Object *obj)
{ {
return write_define_values(obj); return write_define_values(obj);
} }
@ -1125,8 +1125,8 @@ static Scheme_Object *write_module(Scheme_Object *obj)
{ {
Scheme_Module *m = (Scheme_Module *)obj; Scheme_Module *m = (Scheme_Module *)obj;
Scheme_Module_Phase_Exports *pt; Scheme_Module_Phase_Exports *pt;
Scheme_Object *l, *v; Scheme_Object *l, *v, *phase;
int i, k, count, cnt; int i, j, k, count, cnt;
l = scheme_null; l = scheme_null;
cnt = 0; cnt = 0;
@ -1147,22 +1147,27 @@ static Scheme_Object *write_module(Scheme_Object *obj)
l = cons(m->et_requires, l); l = cons(m->et_requires, l);
l = cons(m->requires, l); l = cons(m->requires, l);
l = cons(m->body, l); for (j = 0; j < m->num_phases; j++) {
l = cons(m->et_body, l); l = cons(m->bodies[j], l);
}
cnt = 0; cnt = 0;
for (k = -3; k < (m->me->other_phases ? m->me->other_phases->size : 0); k++) { for (k = -3; k < (m->me->other_phases ? m->me->other_phases->size : 0); k++) {
switch (k) { switch (k) {
case -3: case -3:
phase = scheme_make_integer(-1);
pt = m->me->dt; pt = m->me->dt;
break; break;
case -2: case -2:
phase = scheme_make_integer(1);
pt = m->me->et; pt = m->me->et;
break; break;
case -1: case -1:
phase = scheme_make_integer(0);
pt = m->me->rt; pt = m->me->rt;
break; break;
default: default:
phase = m->me->other_phases->keys[k];
pt = (Scheme_Module_Phase_Exports *)m->me->other_phases->vals[k]; pt = (Scheme_Module_Phase_Exports *)m->me->other_phases->vals[k];
} }
@ -1203,76 +1208,58 @@ static Scheme_Object *write_module(Scheme_Object *obj)
if (pt->provide_src_phases) { if (pt->provide_src_phases) {
v = scheme_make_vector(count, NULL); v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) { for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = (pt->provide_src_phases[i] ? scheme_true : scheme_false); SCHEME_VEC_ELS(v)[i] = scheme_make_integer(pt->provide_src_phases[i]);
} }
} else } else
v = scheme_false; v = scheme_false;
l = cons(v, l); l = cons(v, l);
if ((SCHEME_INT_VAL(phase) >= 0) && (SCHEME_INT_VAL(phase) < m->num_phases)) {
Scheme_Module_Export_Info *exp_info = m->exp_infos[SCHEME_INT_VAL(phase)];
if (exp_info) {
v = scheme_false;
if (exp_info->provide_protects) {
for (i = 0; i < count; i++) {
if (exp_info->provide_protects[i])
break;
}
if (i < count) {
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = (exp_info->provide_protects[i] ? scheme_true : scheme_false);
}
}
}
l = cons(v, l);
count = exp_info->num_indirect_provides;
l = cons(scheme_make_integer(count), l);
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = exp_info->indirect_provides[i];
}
l = cons(v, l);
count = exp_info->num_indirect_syntax_provides;
l = cons(scheme_make_integer(count), l);
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = exp_info->indirect_syntax_provides[i];
}
l = cons(v, l);
} else
l = cons(scheme_void, l);
} else
l = cons(scheme_void, l);
l = cons(pt->phase_index, l); l = cons(pt->phase_index, l);
cnt++; cnt++;
} }
} }
l = cons(scheme_make_integer(cnt), l); l = cons(scheme_make_integer(cnt), l);
l = cons(scheme_make_integer(m->num_phases), l);
count = m->me->rt->num_provides;
if (m->provide_protects) {
for (i = 0; i < count; i++) {
if (m->provide_protects[i])
break;
}
if (i < count) {
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = (m->provide_protects[i] ? scheme_true : scheme_false);
}
} else
v = scheme_false;
l = cons(v, l);
} else
l = cons(scheme_false, l);
count = m->me->et->num_provides;
if (m->et_provide_protects) {
for (i = 0; i < count; i++) {
if (m->et_provide_protects[i])
break;
}
if (i < count) {
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = (m->et_provide_protects[i] ? scheme_true : scheme_false);
}
} else
v = scheme_false;
l = cons(v, l);
} else
l = cons(scheme_false, l);
count = m->num_indirect_provides;
l = cons(scheme_make_integer(count), l);
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = m->indirect_provides[i];
}
l = cons(v, l);
count = m->num_indirect_syntax_provides;
l = cons(scheme_make_integer(count), l);
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = m->indirect_syntax_provides[i];
}
l = cons(v, l);
count = m->num_indirect_et_provides;
l = cons(scheme_make_integer(count), l);
v = scheme_make_vector(count, NULL);
for (i = 0; i < count; i++) {
SCHEME_VEC_ELS(v)[i] = m->et_indirect_provides[i];
}
l = cons(v, l);
l = cons((Scheme_Object *)m->prefix, l); l = cons((Scheme_Object *)m->prefix, l);
l = cons(m->dummy, l); l = cons(m->dummy, l);
@ -1318,12 +1305,14 @@ static int check_requires_ok(Scheme_Object *l)
static Scheme_Object *read_module(Scheme_Object *obj) static Scheme_Object *read_module(Scheme_Object *obj)
{ {
Scheme_Module *m; Scheme_Module *m;
Scheme_Object *ie, *nie; Scheme_Object *ie, *nie, **bodies;
Scheme_Object *eesp, *esp, *esn, *esph, *es, *esnom, *e, *nve, *ne, **v; Scheme_Object *esp, *esn, *esph, *es, *esnom, *e, *nve, *ne, **v;
Scheme_Module_Exports *me; Scheme_Module_Exports *me;
Scheme_Module_Phase_Exports *pt; Scheme_Module_Phase_Exports *pt;
char *ps, *sps; Scheme_Module_Export_Info **exp_infos, *exp_info;
int i, count, cnt; char *ps;
int *sps;
int i, j, count, cnt;
m = MALLOC_ONE_TAGGED(Scheme_Module); m = MALLOC_ONE_TAGGED(Scheme_Module);
m->so.type = scheme_module_type; m->so.type = scheme_module_type;
@ -1387,67 +1376,21 @@ static Scheme_Object *read_module(Scheme_Object *obj)
obj = SCHEME_CDR(obj); obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL(); if (!SCHEME_PAIRP(obj)) return_NULL();
ie = SCHEME_CAR(obj); cnt = SCHEME_INT_VAL(SCHEME_CAR(obj));
obj = SCHEME_CDR(obj); obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL(); if (cnt < 1) return_NULL();
nie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
count = SCHEME_INT_VAL(nie);
if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL(); m->num_phases = cnt;
v = MALLOC_N(Scheme_Object *, count); exp_infos = MALLOC_N(Scheme_Module_Export_Info *, cnt);
for (i = 0; i < count; i++) { while (cnt--) {
v[i] = SCHEME_VEC_ELS(ie)[i]; exp_info = MALLOC_ONE_RT(Scheme_Module_Export_Info);
SET_REQUIRED_TAG(exp_info->type = scheme_rt_export_info);
exp_infos[cnt] = exp_info;
} }
m->et_indirect_provides = v; m->exp_infos = exp_infos;
m->num_indirect_et_provides = count; cnt = m->num_phases;
if (!SCHEME_PAIRP(obj)) return_NULL();
ie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL();
nie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
count = SCHEME_INT_VAL(nie);
if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
v = MALLOC_N(Scheme_Object *, count);
for (i = 0; i < count; i++) {
v[i] = SCHEME_VEC_ELS(ie)[i];
}
m->indirect_syntax_provides = v;
m->num_indirect_syntax_provides = count;
if (!SCHEME_PAIRP(obj)) return_NULL();
ie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL();
nie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
count = SCHEME_INT_VAL(nie);
if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
v = MALLOC_N(Scheme_Object *, count);
for (i = 0; i < count; i++) {
v[i] = SCHEME_VEC_ELS(ie)[i];
}
m->indirect_provides = v;
m->num_indirect_provides = count;
if (!SCHEME_PAIRP(obj)) return_NULL();
eesp = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL();
esp = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL(); if (!SCHEME_PAIRP(obj)) return_NULL();
cnt = SCHEME_INT_VAL(SCHEME_CAR(obj)); cnt = SCHEME_INT_VAL(SCHEME_CAR(obj));
obj = SCHEME_CDR(obj); obj = SCHEME_CDR(obj);
@ -1482,6 +1425,67 @@ static Scheme_Object *read_module(Scheme_Object *obj)
scheme_hash_set(me->other_phases, phase, (Scheme_Object *)pt); scheme_hash_set(me->other_phases, phase, (Scheme_Object *)pt);
} }
if (!SCHEME_PAIRP(obj)) return_NULL();
ie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
if (SCHEME_VOIDP(ie)) {
/* no exp_infos entry */
count = -1;
} else {
if (!SCHEME_INTP(phase) || (SCHEME_INT_VAL(phase) < 0)
|| (SCHEME_INT_VAL(phase) >= m->num_phases))
return_NULL();
exp_info = m->exp_infos[SCHEME_INT_VAL(phase)];
if (!SCHEME_PAIRP(obj)) return_NULL();
nie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
count = SCHEME_INT_VAL(nie);
if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
v = MALLOC_N(Scheme_Object *, count);
for (i = 0; i < count; i++) {
v[i] = SCHEME_VEC_ELS(ie)[i];
}
exp_info->indirect_syntax_provides = v;
exp_info->num_indirect_syntax_provides = count;
if (!SCHEME_PAIRP(obj)) return_NULL();
ie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL();
nie = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
count = SCHEME_INT_VAL(nie);
if (!SCHEME_VECTORP(ie) || (SCHEME_VEC_SIZE(ie) != count)) return_NULL();
v = MALLOC_N(Scheme_Object *, count);
for (i = 0; i < count; i++) {
v[i] = SCHEME_VEC_ELS(ie)[i];
}
exp_info->indirect_provides = v;
exp_info->num_indirect_provides = count;
if (!SCHEME_PAIRP(obj)) return_NULL();
esp = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
if (SCHEME_FALSEP(esp)) {
exp_info->provide_protects = NULL;
count = -1;
} else {
if (!SCHEME_VECTORP(esp)) return_NULL();
count = SCHEME_VEC_SIZE(esp);
ps = MALLOC_N_ATOMIC(char, count);
for (i = 0; i < count; i++) {
ps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(esp)[i]);
}
exp_info->provide_protects = ps;
}
}
if (!SCHEME_PAIRP(obj)) return_NULL(); if (!SCHEME_PAIRP(obj)) return_NULL();
esph = SCHEME_CAR(obj); esph = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj); obj = SCHEME_CDR(obj);
@ -1510,6 +1514,8 @@ static Scheme_Object *read_module(Scheme_Object *obj)
ne = SCHEME_CAR(obj); ne = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj); obj = SCHEME_CDR(obj);
if ((count != -1) && (SCHEME_INT_VAL(ne) != count)) return_NULL();
count = SCHEME_INT_VAL(ne); count = SCHEME_INT_VAL(ne);
pt->num_provides = count; pt->num_provides = count;
pt->num_var_provides = SCHEME_INT_VAL(nve); pt->num_var_provides = SCHEME_INT_VAL(nve);
@ -1550,9 +1556,9 @@ static Scheme_Object *read_module(Scheme_Object *obj)
sps = NULL; sps = NULL;
else { else {
if (!SCHEME_VECTORP(esph) || (SCHEME_VEC_SIZE(esph) != count)) return_NULL(); if (!SCHEME_VECTORP(esph) || (SCHEME_VEC_SIZE(esph) != count)) return_NULL();
sps = MALLOC_N_ATOMIC(char, count); sps = MALLOC_N_ATOMIC(int, count);
for (i = 0; i < count; i++) { for (i = 0; i < count; i++) {
sps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(esph)[i]); sps[i] = SCHEME_INT_VAL(SCHEME_VEC_ELS(esph)[i]);
} }
} }
pt->provide_src_phases = sps; pt->provide_src_phases = sps;
@ -1560,55 +1566,40 @@ static Scheme_Object *read_module(Scheme_Object *obj)
count = me->rt->num_provides; count = me->rt->num_provides;
if (SCHEME_FALSEP(esp)) { bodies = MALLOC_N(Scheme_Object*, m->num_phases);
m->provide_protects = NULL; m->bodies = bodies;
} else { for (j = m->num_phases; j--; ) {
if (!SCHEME_VECTORP(esp) || (SCHEME_VEC_SIZE(esp) != count)) return_NULL(); if (!SCHEME_PAIRP(obj)) return_NULL();
ps = MALLOC_N_ATOMIC(char, count); e = SCHEME_CAR(obj);
for (i = 0; i < count; i++) {
ps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(esp)[i]);
}
m->provide_protects = ps;
}
if (SCHEME_FALSEP(eesp)) {
m->et_provide_protects = NULL;
} else {
if (!SCHEME_VECTORP(eesp) || (SCHEME_VEC_SIZE(eesp) != count)) return_NULL();
ps = MALLOC_N_ATOMIC(char, count);
for (i = 0; i < count; i++) {
ps[i] = SCHEME_TRUEP(SCHEME_VEC_ELS(eesp)[i]);
}
m->et_provide_protects = ps;
}
if (!SCHEME_PAIRP(obj)) return_NULL();
e = SCHEME_CAR(obj);
if (!SCHEME_VECTORP(e)) return_NULL();
m->et_body = e;
for (i = SCHEME_VEC_SIZE(e); i--; ) {
e = SCHEME_VEC_ELS(m->et_body)[i];
if (!SCHEME_VECTORP(e)) return_NULL(); if (!SCHEME_VECTORP(e)) return_NULL();
/* SCHEME_VEC_ELS(e)[1] should be code */ if (j) {
if (!SCHEME_INTP(SCHEME_VEC_ELS(e)[2])) return_NULL(); bodies[j] = e;
if (!SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(e)[3]), scheme_resolve_prefix_type)) for (i = SCHEME_VEC_SIZE(e); i--; ) {
return_NULL(); e = SCHEME_VEC_ELS(bodies[j])[i];
e = SCHEME_VEC_ELS(e)[0]; if (!SCHEME_VECTORP(e)) return_NULL();
if (!SCHEME_SYMBOLP(e)) { if (SCHEME_VEC_SIZE(e) != 5) return_NULL();
while (SCHEME_PAIRP(e)) { /* SCHEME_VEC_ELS(e)[1] should be code */
if (!SCHEME_SYMBOLP(SCHEME_CAR(e))) return_NULL(); if (!SCHEME_INTP(SCHEME_VEC_ELS(e)[2])) return_NULL();
e = SCHEME_CDR(e); if (!SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(e)[3]), scheme_resolve_prefix_type))
return_NULL();
if (SCHEME_FALSEP(SCHEME_VEC_ELS(e)[0])) {
if (SCHEME_FALSEP(SCHEME_VEC_ELS(e)[4])) return_NULL();
} else {
e = SCHEME_VEC_ELS(e)[0];
if (!SCHEME_SYMBOLP(e)) {
while (SCHEME_PAIRP(e)) {
if (!SCHEME_SYMBOLP(SCHEME_CAR(e))) return_NULL();
e = SCHEME_CDR(e);
}
if (!SCHEME_NULLP(e)) return_NULL();
}
}
} }
if (!SCHEME_NULLP(e)) return_NULL(); } else {
bodies[j] = e;
} }
obj = SCHEME_CDR(obj);
} }
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL();
e = SCHEME_CAR(obj);
if (!SCHEME_VECTORP(e)) return_NULL();
m->body = e;
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL(); if (!SCHEME_PAIRP(obj)) return_NULL();
if (scheme_proper_list_length(SCHEME_CAR(obj)) < 0) return_NULL(); if (scheme_proper_list_length(SCHEME_CAR(obj)) < 0) return_NULL();

2436
src/racket/src/module.c
View File

File diff suppressed because it is too large Load Diff

67
src/racket/src/mzmark_type.inc
View File

@ -2167,6 +2167,7 @@ static int namespace_val_MARK(void *p, struct NewGC *gc) {
gcMARK2(e->exp_env, gc); gcMARK2(e->exp_env, gc);
gcMARK2(e->template_env, gc); gcMARK2(e->template_env, gc);
gcMARK2(e->label_env, gc); gcMARK2(e->label_env, gc);
gcMARK2(e->instance_env, gc);
gcMARK2(e->shadowed_syntax, gc); gcMARK2(e->shadowed_syntax, gc);
@ -2176,6 +2177,7 @@ static int namespace_val_MARK(void *p, struct NewGC *gc) {
gcMARK2(e->tt_require_names, gc); gcMARK2(e->tt_require_names, gc);
gcMARK2(e->dt_require_names, gc); gcMARK2(e->dt_require_names, gc);
gcMARK2(e->other_require_names, gc); gcMARK2(e->other_require_names, gc);
gcMARK2(e->running, gc);
gcMARK2(e->did_starts, gc); gcMARK2(e->did_starts, gc);
gcMARK2(e->available_next[0], gc); gcMARK2(e->available_next[0], gc);
gcMARK2(e->available_next[1], gc); gcMARK2(e->available_next[1], gc);
@ -2206,6 +2208,7 @@ static int namespace_val_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(e->exp_env, gc); gcFIXUP2(e->exp_env, gc);
gcFIXUP2(e->template_env, gc); gcFIXUP2(e->template_env, gc);
gcFIXUP2(e->label_env, gc); gcFIXUP2(e->label_env, gc);
gcFIXUP2(e->instance_env, gc);
gcFIXUP2(e->shadowed_syntax, gc); gcFIXUP2(e->shadowed_syntax, gc);
@ -2215,6 +2218,7 @@ static int namespace_val_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(e->tt_require_names, gc); gcFIXUP2(e->tt_require_names, gc);
gcFIXUP2(e->dt_require_names, gc); gcFIXUP2(e->dt_require_names, gc);
gcFIXUP2(e->other_require_names, gc); gcFIXUP2(e->other_require_names, gc);
gcFIXUP2(e->running, gc);
gcFIXUP2(e->did_starts, gc); gcFIXUP2(e->did_starts, gc);
gcFIXUP2(e->available_next[0], gc); gcFIXUP2(e->available_next[0], gc);
gcFIXUP2(e->available_next[1], gc); gcFIXUP2(e->available_next[1], gc);
@ -2508,24 +2512,14 @@ static int module_val_MARK(void *p, struct NewGC *gc) {
gcMARK2(m->dt_requires, gc); gcMARK2(m->dt_requires, gc);
gcMARK2(m->other_requires, gc); gcMARK2(m->other_requires, gc);
gcMARK2(m->body, gc); gcMARK2(m->bodies, gc);
gcMARK2(m->et_body, gc);
gcMARK2(m->me, gc); gcMARK2(m->me, gc);
gcMARK2(m->provide_protects, gc); gcMARK2(m->exp_infos, gc);
gcMARK2(m->indirect_provides, gc);
gcMARK2(m->indirect_syntax_provides, gc);
gcMARK2(m->et_provide_protects, gc);
gcMARK2(m->et_indirect_provides, gc);
gcMARK2(m->self_modidx, gc); gcMARK2(m->self_modidx, gc);
gcMARK2(m->accessible, gc);
gcMARK2(m->et_accessible, gc);
gcMARK2(m->insp, gc); gcMARK2(m->insp, gc);
gcMARK2(m->lang_info, gc); gcMARK2(m->lang_info, gc);
@ -2558,24 +2552,14 @@ static int module_val_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(m->dt_requires, gc); gcFIXUP2(m->dt_requires, gc);
gcFIXUP2(m->other_requires, gc); gcFIXUP2(m->other_requires, gc);
gcFIXUP2(m->body, gc); gcFIXUP2(m->bodies, gc);
gcFIXUP2(m->et_body, gc);
gcFIXUP2(m->me, gc); gcFIXUP2(m->me, gc);
gcFIXUP2(m->provide_protects, gc); gcFIXUP2(m->exp_infos, gc);
gcFIXUP2(m->indirect_provides, gc);
gcFIXUP2(m->indirect_syntax_provides, gc);
gcFIXUP2(m->et_provide_protects, gc);
gcFIXUP2(m->et_indirect_provides, gc);
gcFIXUP2(m->self_modidx, gc); gcFIXUP2(m->self_modidx, gc);
gcFIXUP2(m->accessible, gc);
gcFIXUP2(m->et_accessible, gc);
gcFIXUP2(m->insp, gc); gcFIXUP2(m->insp, gc);
gcFIXUP2(m->lang_info, gc); gcFIXUP2(m->lang_info, gc);
@ -2598,6 +2582,41 @@ static int module_val_FIXUP(void *p, struct NewGC *gc) {
#define module_val_IS_CONST_SIZE 1 #define module_val_IS_CONST_SIZE 1
static int exp_info_val_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
}
static int exp_info_val_MARK(void *p, struct NewGC *gc) {
Scheme_Module_Export_Info *m = (Scheme_Module_Export_Info *)p;
gcMARK2(m->provide_protects, gc);
gcMARK2(m->indirect_provides, gc);
gcMARK2(m->indirect_syntax_provides, gc);
gcMARK2(m->accessible, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
}
static int exp_info_val_FIXUP(void *p, struct NewGC *gc) {
Scheme_Module_Export_Info *m = (Scheme_Module_Export_Info *)p;
gcFIXUP2(m->provide_protects, gc);
gcFIXUP2(m->indirect_provides, gc);
gcFIXUP2(m->indirect_syntax_provides, gc);
gcFIXUP2(m->accessible, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
}
#define exp_info_val_IS_ATOMIC 0
#define exp_info_val_IS_CONST_SIZE 1
static int module_phase_exports_val_SIZE(void *p, struct NewGC *gc) { static int module_phase_exports_val_SIZE(void *p, struct NewGC *gc) {
return return
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Phase_Exports)); gcBYTES_TO_WORDS(sizeof(Scheme_Module_Phase_Exports));

30
src/racket/src/mzmarksrc.c
View File

@ -876,6 +876,7 @@ namespace_val {
gcMARK2(e->exp_env, gc); gcMARK2(e->exp_env, gc);
gcMARK2(e->template_env, gc); gcMARK2(e->template_env, gc);
gcMARK2(e->label_env, gc); gcMARK2(e->label_env, gc);
gcMARK2(e->instance_env, gc);
gcMARK2(e->shadowed_syntax, gc); gcMARK2(e->shadowed_syntax, gc);
@ -885,6 +886,7 @@ namespace_val {
gcMARK2(e->tt_require_names, gc); gcMARK2(e->tt_require_names, gc);
gcMARK2(e->dt_require_names, gc); gcMARK2(e->dt_require_names, gc);
gcMARK2(e->other_require_names, gc); gcMARK2(e->other_require_names, gc);
gcMARK2(e->running, gc);
gcMARK2(e->did_starts, gc); gcMARK2(e->did_starts, gc);
gcMARK2(e->available_next[0], gc); gcMARK2(e->available_next[0], gc);
gcMARK2(e->available_next[1], gc); gcMARK2(e->available_next[1], gc);
@ -1009,24 +1011,14 @@ module_val {
gcMARK2(m->dt_requires, gc); gcMARK2(m->dt_requires, gc);
gcMARK2(m->other_requires, gc); gcMARK2(m->other_requires, gc);
gcMARK2(m->body, gc); gcMARK2(m->bodies, gc);
gcMARK2(m->et_body, gc);
gcMARK2(m->me, gc); gcMARK2(m->me, gc);
gcMARK2(m->provide_protects, gc); gcMARK2(m->exp_infos, gc);
gcMARK2(m->indirect_provides, gc);
gcMARK2(m->indirect_syntax_provides, gc);
gcMARK2(m->et_provide_protects, gc);
gcMARK2(m->et_indirect_provides, gc);
gcMARK2(m->self_modidx, gc); gcMARK2(m->self_modidx, gc);
gcMARK2(m->accessible, gc);
gcMARK2(m->et_accessible, gc);
gcMARK2(m->insp, gc); gcMARK2(m->insp, gc);
gcMARK2(m->lang_info, gc); gcMARK2(m->lang_info, gc);
@ -1045,6 +1037,20 @@ module_val {
gcBYTES_TO_WORDS(sizeof(Scheme_Module)); gcBYTES_TO_WORDS(sizeof(Scheme_Module));
} }
exp_info_val {
mark:
Scheme_Module_Export_Info *m = (Scheme_Module_Export_Info *)p;
gcMARK2(m->provide_protects, gc);
gcMARK2(m->indirect_provides, gc);
gcMARK2(m->indirect_syntax_provides, gc);
gcMARK2(m->accessible, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Export_Info));
}
module_phase_exports_val { module_phase_exports_val {
mark: mark:
Scheme_Module_Phase_Exports *m = (Scheme_Module_Phase_Exports *)p; Scheme_Module_Phase_Exports *m = (Scheme_Module_Phase_Exports *)p;

51
src/racket/src/optimize.c
View File

@ -2996,7 +2996,7 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context)
return obj; return obj;
} }
static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int for_stx) static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info)
{ {
Scheme_Object *val; Scheme_Object *val;
Optimize_Info *einfo; Optimize_Info *einfo;
@ -3016,12 +3016,29 @@ static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_
static Scheme_Object *define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int context) static Scheme_Object *define_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int context)
{ {
return do_define_syntaxes_optimize(data, info, 0); return do_define_syntaxes_optimize(data, info);
} }
static Scheme_Object *define_for_syntaxes_optimize(Scheme_Object *data, Optimize_Info *info, int context) static Scheme_Object *begin_for_syntax_optimize(Scheme_Object *data, Optimize_Info *info, int context)
{ {
return do_define_syntaxes_optimize(data, info, 1); Scheme_Object *l, *a;
Optimize_Info *einfo;
l = SCHEME_VEC_ELS(data)[2];
while (!SCHEME_NULLP(l)) {
einfo = scheme_optimize_info_create();
if (info->inline_fuel < 0)
einfo->inline_fuel = -1;
a = SCHEME_CAR(l);
a = scheme_optimize_expr(a, einfo, 0);
SCHEME_CAR(l) = a;
l = SCHEME_CDR(l);
}
return data;
} }
/*========================================================================*/ /*========================================================================*/
@ -4517,7 +4534,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
old_context = info->context; old_context = info->context;
info->context = (Scheme_Object *)m; info->context = (Scheme_Object *)m;
cnt = SCHEME_VEC_SIZE(m->body); cnt = SCHEME_VEC_SIZE(m->bodies[0]);
if (OPT_ESTIMATE_FUTURE_SIZES) { if (OPT_ESTIMATE_FUTURE_SIZES) {
if (info->enforce_const) { if (info->enforce_const) {
@ -4525,7 +4542,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
size estimate, which is used to discourage early loop unrolling size estimate, which is used to discourage early loop unrolling
at the expense of later inlining. */ at the expense of later inlining. */
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
e = SCHEME_VEC_ELS(m->body)[i_m]; e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
int n; int n;
@ -4562,7 +4579,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->body)[i_m]; e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
is_proc_def = 0; is_proc_def = 0;
if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) { if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) {
@ -4587,7 +4604,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
info->use_psize = 0; info->use_psize = 0;
info->inline_fuel = inline_fuel; info->inline_fuel = inline_fuel;
} }
SCHEME_VEC_ELS(m->body)[i_m] = e; SCHEME_VEC_ELS(m->bodies[0])[i_m] = e;
if (info->enforce_const) { if (info->enforce_const) {
/* If this expression/definition can't have any side effect /* If this expression/definition can't have any side effect
@ -4717,7 +4734,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
shift-cloning, since there are no local variables in scope. */ shift-cloning, since there are no local variables in scope. */
int old_sz, new_sz; int old_sz, new_sz;
e = SCHEME_VEC_ELS(m->body)[start_simltaneous]; e = SCHEME_VEC_ELS(m->bodies[0])[start_simltaneous];
if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE) { if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
@ -4730,7 +4747,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
old_sz = 0; old_sz = 0;
e = scheme_optimize_expr(e, info, 0); e = scheme_optimize_expr(e, info, 0);
SCHEME_VEC_ELS(m->body)[start_simltaneous] = e; SCHEME_VEC_ELS(m->bodies[0])[start_simltaneous] = e;
if (re_consts) { if (re_consts) {
/* Install optimized closures into constant table --- /* Install optimized closures into constant table ---
@ -4809,7 +4826,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
int can_omit = 0; int can_omit = 0;
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->body)[i_m]; e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
if (scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) { if (scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) {
can_omit++; can_omit++;
} }
@ -4820,12 +4837,12 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
vec = scheme_make_vector(cnt - can_omit, NULL); vec = scheme_make_vector(cnt - can_omit, NULL);
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->body)[i_m]; e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
if (!scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) { if (!scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) {
SCHEME_VEC_ELS(vec)[j++] = e; SCHEME_VEC_ELS(vec)[j++] = e;
} }
} }
m->body = vec; m->bodies[0] = vec;
} }
} }
@ -5007,8 +5024,8 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
return set_optimize(expr, info, context); return set_optimize(expr, info, context);
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
return define_syntaxes_optimize(expr, info, context); return define_syntaxes_optimize(expr, info, context);
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
return define_for_syntaxes_optimize(expr, info, context); return begin_for_syntax_optimize(expr, info, context);
case scheme_case_lambda_sequence_type: case scheme_case_lambda_sequence_type:
return case_lambda_optimize(expr, info, context); return case_lambda_optimize(expr, info, context);
case scheme_begin0_sequence_type: case scheme_begin0_sequence_type:
@ -5225,7 +5242,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
return expr; return expr;
case scheme_define_values_type: case scheme_define_values_type:
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
case scheme_boxenv_type: case scheme_boxenv_type:
return NULL; return NULL;
case scheme_require_form_type: case scheme_require_form_type:
@ -5396,7 +5413,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
case scheme_boxenv_type: case scheme_boxenv_type:
case scheme_define_values_type: case scheme_define_values_type:
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
case scheme_require_form_type: case scheme_require_form_type:
case scheme_module_type: case scheme_module_type:
scheme_signal_error("scheme_optimize_shift: no shift available for %d", SCHEME_TYPE(expr)); scheme_signal_error("scheme_optimize_shift: no shift available for %d", SCHEME_TYPE(expr));

61
src/racket/src/resolve.c
View File

@ -729,7 +729,7 @@ case_lambda_resolve(Scheme_Object *expr, Resolve_Info *rslv)
return expr; return expr;
} }
static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info, int for_stx) static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info)
{ {
Comp_Prefix *cp; Comp_Prefix *cp;
Resolve_Prefix *rp; Resolve_Prefix *rp;
@ -748,8 +748,6 @@ static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_In
einfo = scheme_resolve_info_create(rp); einfo = scheme_resolve_info_create(rp);
if (for_stx)
names = scheme_resolve_list(names, einfo);
val = scheme_resolve_expr(val, einfo); val = scheme_resolve_expr(val, einfo);
rp = scheme_remap_prefix(rp, einfo); rp = scheme_remap_prefix(rp, einfo);
@ -770,19 +768,54 @@ static Scheme_Object *do_define_syntaxes_resolve(Scheme_Object *data, Resolve_In
names = SCHEME_CDR(names); names = SCHEME_CDR(names);
} }
vec->type = (for_stx ? scheme_define_for_syntax_type : scheme_define_syntaxes_type); vec->type = scheme_define_syntaxes_type;
return vec; return vec;
} }
static Scheme_Object *define_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info) static Scheme_Object *define_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info)
{ {
return do_define_syntaxes_resolve(data, info, 0); return do_define_syntaxes_resolve(data, info);
} }
static Scheme_Object *define_for_syntaxes_resolve(Scheme_Object *data, Resolve_Info *info) static Scheme_Object *begin_for_syntax_resolve(Scheme_Object *data, Resolve_Info *info)
{ {
return do_define_syntaxes_resolve(data, info, 1); Comp_Prefix *cp;
Resolve_Prefix *rp;
Scheme_Object *l, *p, *a, *base_stack_depth, *dummy, *vec;
Resolve_Info *einfo;
cp = (Comp_Prefix *)SCHEME_VEC_ELS(data)[0];
dummy = SCHEME_VEC_ELS(data)[1];
l = SCHEME_VEC_ELS(data)[2];
rp = scheme_resolve_prefix(1, cp, 1);
dummy = scheme_resolve_expr(dummy, info);
einfo = scheme_resolve_info_create(rp);
p = scheme_null;
while (!SCHEME_NULLP(l)) {
a = SCHEME_CAR(l);
a = scheme_resolve_expr(a, einfo);
p = scheme_make_pair(a, p);
l = SCHEME_CDR(l);
}
l = scheme_reverse(p);
rp = scheme_remap_prefix(rp, einfo);
base_stack_depth = scheme_make_integer(einfo->max_let_depth);
vec = scheme_make_vector(4, NULL);
SCHEME_VEC_ELS(vec)[0] = l;
SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)rp;
SCHEME_VEC_ELS(vec)[2] = base_stack_depth;
SCHEME_VEC_ELS(vec)[3] = dummy;
vec->type = scheme_begin_for_syntax_type;
return vec;
} }
/*========================================================================*/ /*========================================================================*/
@ -2152,20 +2185,20 @@ module_expr_resolve(Scheme_Object *data, Resolve_Info *old_rslv)
rslv->in_module = 1; rslv->in_module = 1;
scheme_enable_expression_resolve_lifts(rslv); scheme_enable_expression_resolve_lifts(rslv);
cnt = SCHEME_VEC_SIZE(m->body); cnt = SCHEME_VEC_SIZE(m->bodies[0]);
for (i = 0; i < cnt; i++) { for (i = 0; i < cnt; i++) {
Scheme_Object *e; Scheme_Object *e;
e = scheme_resolve_expr(SCHEME_VEC_ELS(m->body)[i], rslv); e = scheme_resolve_expr(SCHEME_VEC_ELS(m->bodies[0])[i], rslv);
SCHEME_VEC_ELS(m->body)[i] = e; SCHEME_VEC_ELS(m->bodies[0])[i] = e;
} }
m->max_let_depth = rslv->max_let_depth; m->max_let_depth = rslv->max_let_depth;
lift_vec = rslv->lifts; lift_vec = rslv->lifts;
if (!SCHEME_NULLP(SCHEME_VEC_ELS(lift_vec)[0])) { if (!SCHEME_NULLP(SCHEME_VEC_ELS(lift_vec)[0])) {
b = scheme_append(SCHEME_VEC_ELS(lift_vec)[0], scheme_vector_to_list(m->body)); b = scheme_append(SCHEME_VEC_ELS(lift_vec)[0], scheme_vector_to_list(m->bodies[0]));
b = scheme_list_to_vector(b); b = scheme_list_to_vector(b);
m->body = b; m->bodies[0] = b;
} }
rp->num_lifts = SCHEME_INT_VAL(SCHEME_VEC_ELS(lift_vec)[1]); rp->num_lifts = SCHEME_INT_VAL(SCHEME_VEC_ELS(lift_vec)[1]);
@ -2288,8 +2321,8 @@ Scheme_Object *scheme_resolve_expr(Scheme_Object *expr, Resolve_Info *info)
return define_values_resolve(expr, info); return define_values_resolve(expr, info);
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
return define_syntaxes_resolve(expr, info); return define_syntaxes_resolve(expr, info);
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
return define_for_syntaxes_resolve(expr, info); return begin_for_syntax_resolve(expr, info);
case scheme_set_bang_type: case scheme_set_bang_type:
return set_resolve(expr, info); return set_resolve(expr, info);
case scheme_require_form_type: case scheme_require_form_type:

43
src/racket/src/schpriv.h
View File

@ -398,7 +398,7 @@ extern Scheme_Object *scheme_begin_stx;
extern Scheme_Object *scheme_module_begin_stx; extern Scheme_Object *scheme_module_begin_stx;
extern Scheme_Object *scheme_define_values_stx; extern Scheme_Object *scheme_define_values_stx;
extern Scheme_Object *scheme_define_syntaxes_stx; extern Scheme_Object *scheme_define_syntaxes_stx;
extern Scheme_Object *scheme_define_for_syntaxes_stx; extern Scheme_Object *scheme_begin_for_syntax_stx;
extern Scheme_Object *scheme_top_stx; extern Scheme_Object *scheme_top_stx;
extern Scheme_Object *scheme_recur_symbol, *scheme_display_symbol, *scheme_write_special_symbol; extern Scheme_Object *scheme_recur_symbol, *scheme_display_symbol, *scheme_write_special_symbol;
@ -2672,7 +2672,7 @@ struct Start_Module_Args;
#ifdef MZ_USE_JIT #ifdef MZ_USE_JIT
void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name); void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name);
void *scheme_module_exprun_start(Scheme_Env *menv, int set_ns, Scheme_Object *name); void *scheme_module_exprun_start(Scheme_Env *menv, int phase_plus_set_ns, Scheme_Object *name);
void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name); void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name);
#endif #endif
void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env); void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env);
@ -2931,6 +2931,7 @@ struct Scheme_Env {
struct Scheme_Env *exp_env; struct Scheme_Env *exp_env;
struct Scheme_Env *template_env; struct Scheme_Env *template_env;
struct Scheme_Env *label_env; struct Scheme_Env *label_env;
struct Scheme_Env *instance_env; /* shortcut to env where module is instantiated */
Scheme_Hash_Table *shadowed_syntax; /* top level only */ Scheme_Hash_Table *shadowed_syntax; /* top level only */
@ -2939,7 +2940,8 @@ struct Scheme_Env {
Scheme_Object *link_midx; Scheme_Object *link_midx;
Scheme_Object *require_names, *et_require_names, *tt_require_names, *dt_require_names; /* resolved */ Scheme_Object *require_names, *et_require_names, *tt_require_names, *dt_require_names; /* resolved */
Scheme_Hash_Table *other_require_names; Scheme_Hash_Table *other_require_names;
char running, et_running, attached, ran; char *running; /* array of size `num_phases' if `module' and `mod_phase==0' */
char attached, ran;
Scheme_Object *did_starts; Scheme_Object *did_starts;
Scheme_Object *available_next[2]; Scheme_Object *available_next[2];
@ -2964,6 +2966,19 @@ struct Scheme_Env {
/* A Scheme_Module corresponds to a module declaration. A module /* A Scheme_Module corresponds to a module declaration. A module
instantiation is reprsented by a Scheme_Env */ instantiation is reprsented by a Scheme_Env */
typedef struct Scheme_Module_Export_Info {
MZTAG_IF_REQUIRED
char *provide_protects; /* 1 => protected, 0 => not */
Scheme_Object **indirect_provides; /* symbols (internal names) */
int num_indirect_provides;
/* Only if needed to reconstruct the renaming: */
Scheme_Object **indirect_syntax_provides; /* symbols (internal names) */
int num_indirect_syntax_provides;
Scheme_Hash_Table *accessible; /* (symbol -> ...) */
} Scheme_Module_Export_Info;
typedef struct Scheme_Module typedef struct Scheme_Module
{ {
Scheme_Object so; /* scheme_module_type */ Scheme_Object so; /* scheme_module_type */
@ -2982,29 +2997,17 @@ typedef struct Scheme_Module
Scheme_Invoke_Proc prim_body; Scheme_Invoke_Proc prim_body;
Scheme_Invoke_Proc prim_et_body; Scheme_Invoke_Proc prim_et_body;
Scheme_Object *body; /* or data, if prim_body */ Scheme_Object **bodies; /* array `num_phases' long */
Scheme_Object *et_body; /* list of (vector list-of-names expr depth-int resolve-prefix) */
char no_cert; char no_cert;
struct Scheme_Module_Exports *me; struct Scheme_Module_Exports *me;
char *provide_protects; /* 1 => protected, 0 => not */ int num_phases;
Scheme_Object **indirect_provides; /* symbols (internal names) */ Scheme_Module_Export_Info **exp_infos; /* array `num_phases' long */
int num_indirect_provides;
/* Only if needed to reconstruct the renaming: */
Scheme_Object **indirect_syntax_provides; /* symbols (internal names) */
int num_indirect_syntax_provides;
char *et_provide_protects; /* 1 => protected, 0 => not */
Scheme_Object **et_indirect_provides; /* symbols (internal names) */
int num_indirect_et_provides;
Scheme_Object *self_modidx; Scheme_Object *self_modidx;
Scheme_Hash_Table *accessible; /* (symbol -> ...) */
Scheme_Hash_Table *et_accessible; /* phase -> (symbol -> ...) */
Scheme_Object *insp; /* declaration-time inspector, for module instantiation Scheme_Object *insp; /* declaration-time inspector, for module instantiation
and enabling access to protected imports */ and enabling access to protected imports */
@ -3036,7 +3039,7 @@ typedef struct Scheme_Module_Phase_Exports
Scheme_Object **provide_srcs; /* module access paths, #f for self */ Scheme_Object **provide_srcs; /* module access paths, #f for self */
Scheme_Object **provide_src_names; /* symbols (original internal names) */ Scheme_Object **provide_src_names; /* symbols (original internal names) */
Scheme_Object **provide_nominal_srcs; /* import source if re-exported; NULL or array of lists */ Scheme_Object **provide_nominal_srcs; /* import source if re-exported; NULL or array of lists */
char *provide_src_phases; /* NULL, or src phase for for-syntax import */ int *provide_src_phases; /* NULL, or src phase for for-syntax import */
int num_provides; int num_provides;
int num_var_provides; /* non-syntax listed first in provides */ int num_var_provides; /* non-syntax listed first in provides */
@ -3142,7 +3145,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
Scheme_Env *from_env, int *_would_complain, Scheme_Env *from_env, int *_would_complain,
Scheme_Object **_is_constant); Scheme_Object **_is_constant);
void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env); void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env);
Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name); Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name, int mod_phase);
Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx, Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,
Scheme_Object *shift_from_modidx, Scheme_Object *shift_from_modidx,

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "5.1.3.6" #define MZSCHEME_VERSION "5.1.3.7"
#define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1 #define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 3 #define MZSCHEME_VERSION_Z 3
#define MZSCHEME_VERSION_W 6 #define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

54
src/racket/src/sfs.c
View File

@ -937,9 +937,23 @@ static Scheme_Object *define_syntaxes_sfs(Scheme_Object *data, SFS_Info *info)
return do_define_syntaxes_sfs(data, info); return do_define_syntaxes_sfs(data, info);
} }
static Scheme_Object *define_for_syntaxes_sfs(Scheme_Object *data, SFS_Info *info) static Scheme_Object *begin_for_syntax_sfs(Scheme_Object *data, SFS_Info *info)
{ {
return do_define_syntaxes_sfs(data, info); Scheme_Object *l, *a;
if (!info->pass) {
int depth;
depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[2]);
for (l = SCHEME_VEC_ELS(data)[0]; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
a = SCHEME_CAR(l);
info = scheme_new_sfs_info(depth);
a = scheme_sfs(a, info, depth);
SCHEME_CAR(l) = a;
}
}
return data;
} }
/*========================================================================*/ /*========================================================================*/
@ -1051,7 +1065,7 @@ module_sfs(Scheme_Object *data, SFS_Info *old_info)
Scheme_Module *m = (Scheme_Module *)data; Scheme_Module *m = (Scheme_Module *)data;
Scheme_Object *e, *ex; Scheme_Object *e, *ex;
SFS_Info *info; SFS_Info *info;
int i, cnt, let_depth; int i, j, cnt, let_depth;
if (!old_info->for_mod) { if (!old_info->for_mod) {
if (old_info->pass) if (old_info->pass)
@ -1065,25 +1079,27 @@ module_sfs(Scheme_Object *data, SFS_Info *old_info)
info = old_info; info = old_info;
cnt = SCHEME_VEC_SIZE(m->body); cnt = SCHEME_VEC_SIZE(m->bodies[0]);
scheme_sfs_start_sequence(info, cnt, 0); scheme_sfs_start_sequence(info, cnt, 0);
for (i = 0; i < cnt; i++) { for (i = 0; i < cnt; i++) {
e = scheme_sfs_expr(SCHEME_VEC_ELS(m->body)[i], info, -1); e = scheme_sfs_expr(SCHEME_VEC_ELS(m->bodies[0])[i], info, -1);
SCHEME_VEC_ELS(m->body)[i] = e; SCHEME_VEC_ELS(m->bodies[0])[i] = e;
} }
if (!info->pass) { if (!info->pass) {
cnt = SCHEME_VEC_SIZE(m->et_body); for (j = m->num_phases; j-- > 1; ) {
for (i = 0; i < cnt; i++) { cnt = SCHEME_VEC_SIZE(m->bodies[j]);
e = SCHEME_VEC_ELS(m->et_body)[i]; for (i = 0; i < cnt; i++) {
e = SCHEME_VEC_ELS(m->bodies[j])[i];
let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
ex = SCHEME_VEC_ELS(e)[1]; let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
ex = SCHEME_VEC_ELS(e)[1];
info = scheme_new_sfs_info(let_depth);
ex = scheme_sfs(ex, info, let_depth); info = scheme_new_sfs_info(let_depth);
SCHEME_VEC_ELS(e)[1] = ex; ex = scheme_sfs(ex, info, let_depth);
SCHEME_VEC_ELS(e)[1] = ex;
}
} }
} }
@ -1205,11 +1221,11 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
expr = define_values_sfs(expr, info); expr = define_values_sfs(expr, info);
break; break;
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
expr = define_for_syntaxes_sfs(expr, info);
break;
case scheme_define_for_syntax_type:
expr = define_syntaxes_sfs(expr, info); expr = define_syntaxes_sfs(expr, info);
break; break;
case scheme_begin_for_syntax_type:
expr = begin_for_syntax_sfs(expr, info);
break;
case scheme_set_bang_type: case scheme_set_bang_type:
expr = set_sfs(expr, info); expr = set_sfs(expr, info);
break; break;

4
src/racket/src/startup.inc
View File

@ -8,8 +8,8 @@
" let let* letrec" " let let* letrec"
" parameterize" " parameterize"
" define)" " define)"
"(define-values-for-syntax(here-stx)" "(begin-for-syntax "
"(quote-syntax here))" "(define-values(here-stx)(quote-syntax here)))"
"(define-syntaxes(unless)" "(define-syntaxes(unless)"
"(lambda(stx)" "(lambda(stx)"
"(let-values(((s)(syntax->list stx)))" "(let-values(((s)(syntax->list stx)))"

4
src/racket/src/startup.rktl
View File

@ -41,8 +41,8 @@
parameterize parameterize
define) define)
(define-values-for-syntax (here-stx) (begin-for-syntax
(quote-syntax here)) (define-values (here-stx) (quote-syntax here)))
(define-syntaxes (unless) (define-syntaxes (unless)
(lambda (stx) (lambda (stx)

3
src/racket/src/stypes.h
View File

@ -20,7 +20,7 @@ enum {
scheme_define_values_type, /* 15 */ scheme_define_values_type, /* 15 */
scheme_define_syntaxes_type, /* 16 */ scheme_define_syntaxes_type, /* 16 */
scheme_define_for_syntax_type, /* 17 */ scheme_begin_for_syntax_type, /* 17 */
scheme_set_bang_type, /* 18 */ scheme_set_bang_type, /* 18 */
scheme_boxenv_type, /* 19 */ scheme_boxenv_type, /* 19 */
scheme_begin0_sequence_type, /* 20 */ scheme_begin0_sequence_type, /* 20 */
@ -270,6 +270,7 @@ enum {
scheme_rt_validate_clearing, /* 246 */ scheme_rt_validate_clearing, /* 246 */
scheme_rt_rb_node, /* 247 */ scheme_rt_rb_node, /* 247 */
scheme_rt_lightweight_cont, /* 248 */ scheme_rt_lightweight_cont, /* 248 */
scheme_rt_export_info, /* 249 */
#endif #endif
_scheme_last_type_ _scheme_last_type_

5
src/racket/src/syntax.c
View File

@ -4355,8 +4355,11 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
result = glob_id; result = glob_id;
} else { } else {
result = SCHEME_CDR(rename); result = SCHEME_CDR(rename);
if (SCHEME_PAIRP(result)) if (SCHEME_PAIRP(result)) {
if (SCHEME_INTP(SCHEME_CAR(result))) /* phase? */
result = SCHEME_CDR(result);
result = SCHEME_CAR(result); result = SCHEME_CAR(result);
}
} }
} else } else
result = glob_id; result = glob_id;

5
src/racket/src/type.c
View File

@ -125,7 +125,7 @@ scheme_init_type ()
set_name(scheme_define_values_type, "<define-values-code>"); set_name(scheme_define_values_type, "<define-values-code>");
set_name(scheme_define_syntaxes_type, "<define-syntaxes-code>"); set_name(scheme_define_syntaxes_type, "<define-syntaxes-code>");
set_name(scheme_define_for_syntax_type, "<define-for-syntax-code>"); set_name(scheme_begin_for_syntax_type, "<begin-for-syntax-code>");
set_name(scheme_begin0_sequence_type, "<begin0-code>"); set_name(scheme_begin0_sequence_type, "<begin0-code>");
set_name(scheme_splice_sequence_type, "<splicing-begin-code>"); set_name(scheme_splice_sequence_type, "<splicing-begin-code>");
set_name(scheme_module_type, "<module-code>"); set_name(scheme_module_type, "<module-code>");
@ -540,7 +540,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_define_values_type, vector_obj); GC_REG_TRAV(scheme_define_values_type, vector_obj);
GC_REG_TRAV(scheme_define_syntaxes_type, vector_obj); GC_REG_TRAV(scheme_define_syntaxes_type, vector_obj);
GC_REG_TRAV(scheme_define_for_syntax_type, vector_obj); GC_REG_TRAV(scheme_begin_for_syntax_type, vector_obj);
GC_REG_TRAV(scheme_varref_form_type, twoptr_obj); GC_REG_TRAV(scheme_varref_form_type, twoptr_obj);
GC_REG_TRAV(scheme_apply_values_type, twoptr_obj); GC_REG_TRAV(scheme_apply_values_type, twoptr_obj);
GC_REG_TRAV(scheme_boxenv_type, twoptr_obj); GC_REG_TRAV(scheme_boxenv_type, twoptr_obj);
@ -549,6 +549,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_splice_sequence_type, seq_rec); GC_REG_TRAV(scheme_splice_sequence_type, seq_rec);
GC_REG_TRAV(scheme_set_bang_type, set_bang); GC_REG_TRAV(scheme_set_bang_type, set_bang);
GC_REG_TRAV(scheme_module_type, module_val); GC_REG_TRAV(scheme_module_type, module_val);
GC_REG_TRAV(scheme_rt_export_info, exp_info_val);
GC_REG_TRAV(scheme_require_form_type, twoptr_obj); GC_REG_TRAV(scheme_require_form_type, twoptr_obj);
GC_REG_TRAV(_scheme_values_types_, bad_trav); GC_REG_TRAV(_scheme_values_types_, bad_trav);

59
src/racket/src/validate.c
View File

@ -430,7 +430,7 @@ static void do_define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
Scheme_Object *name, *val, *base_stack_depth, *dummy; Scheme_Object *name, *val, *base_stack_depth, *dummy;
int sdepth; int sdepth;
if (!SAME_TYPE(SCHEME_TYPE(data), (for_stx ? scheme_define_for_syntax_type : scheme_define_syntaxes_type)) if (!SAME_TYPE(SCHEME_TYPE(data), (for_stx ? scheme_begin_for_syntax_type : scheme_define_syntaxes_type))
|| (SCHEME_VEC_SIZE(data) < 4)) || (SCHEME_VEC_SIZE(data) < 4))
scheme_ill_formed_code(port); scheme_ill_formed_code(port);
@ -462,10 +462,13 @@ static void do_define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
if (!for_stx) { if (!for_stx) {
scheme_validate_code(port, SCHEME_VEC_ELS(data)[0], sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, 0); scheme_validate_code(port, SCHEME_VEC_ELS(data)[0], sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, 0);
} else { } else {
/* Make a fake `define-values' to check with respect to the exp-time stack */ val = SCHEME_VEC_ELS(data)[0];
val = scheme_clone_vector(data, 3, 1); while (SCHEME_PAIRP(val)) {
SCHEME_VEC_ELS(val)[0] = SCHEME_VEC_ELS(data)[0]; scheme_validate_code(port, SCHEME_CAR(val), sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, 0);
scheme_validate_code(port, val, sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, 0); val = SCHEME_CDR(val);
}
if (!SCHEME_NULLP(val))
scheme_ill_formed_code(port);
} }
} }
@ -481,13 +484,13 @@ static void define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
num_toplevels, num_stxes, num_lifts, tl_use_map, 0); num_toplevels, num_stxes, num_lifts, tl_use_map, 0);
} }
static void define_for_syntaxes_validate(Scheme_Object *data, Mz_CPort *port, static void begin_for_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls, char *stack, Validate_TLS tls,
int depth, int letlimit, int delta, int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts, int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored, void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos, struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs) Scheme_Hash_Tree *procs)
{ {
do_define_syntaxes_validate(data, port, stack, tls, depth, letlimit, delta, do_define_syntaxes_validate(data, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map, 1); num_toplevels, num_stxes, num_lifts, tl_use_map, 1);
@ -849,7 +852,7 @@ static void module_validate(Scheme_Object *data, Mz_CPort *port,
Scheme_Hash_Tree *procs) Scheme_Hash_Tree *procs)
{ {
Scheme_Module *m; Scheme_Module *m;
int i, cnt, let_depth; int i, j, cnt, let_depth;
Resolve_Prefix *rp; Resolve_Prefix *rp;
Scheme_Object *e; Scheme_Object *e;
@ -859,23 +862,25 @@ static void module_validate(Scheme_Object *data, Mz_CPort *port,
if (!SCHEME_MODNAMEP(m->modname)) if (!SCHEME_MODNAMEP(m->modname))
scheme_ill_formed_code(port); scheme_ill_formed_code(port);
scheme_validate_code(port, m->body, m->max_let_depth, scheme_validate_code(port, m->bodies[0], m->max_let_depth,
m->prefix->num_toplevels, m->prefix->num_stxes, m->prefix->num_lifts, m->prefix->num_toplevels, m->prefix->num_stxes, m->prefix->num_lifts,
NULL, NULL,
1); 1);
/* validate exp-time code */ /* validate exp-time code */
cnt = SCHEME_VEC_SIZE(m->et_body); for (j = m->num_phases; j-- > 1; ) {
for (i = 0; i < cnt; i++) { cnt = SCHEME_VEC_SIZE(m->bodies[j]);
e = SCHEME_VEC_ELS(m->et_body)[i]; for (i = 0; i < cnt; i++) {
e = SCHEME_VEC_ELS(m->bodies[j])[i];
let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]); let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
rp = (Resolve_Prefix *)SCHEME_VEC_ELS(e)[3]; rp = (Resolve_Prefix *)SCHEME_VEC_ELS(e)[3];
e = SCHEME_VEC_ELS(e)[1]; e = SCHEME_VEC_ELS(e)[1];
scheme_validate_code(port, e, let_depth, scheme_validate_code(port, e, let_depth,
rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL, rp->num_toplevels, rp->num_stxes, rp->num_lifts, NULL,
0); 0);
}
} }
} }
@ -1442,11 +1447,11 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
num_toplevels, num_stxes, num_lifts, tl_use_map, num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs); result_ignored, vc, tailpos, procs);
break; break;
case scheme_define_for_syntax_type: case scheme_begin_for_syntax_type:
no_flo(need_flonum, port); no_flo(need_flonum, port);
define_for_syntaxes_validate(expr, port, stack, tls, depth, letlimit, delta, begin_for_syntaxes_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map, num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs); result_ignored, vc, tailpos, procs);
break; break;
case scheme_set_bang_type: case scheme_set_bang_type:
no_flo(need_flonum, port); no_flo(need_flonum, port);