Trying to improve module handling
svn: r4506 original commit: 595ed011724ba002a3bf400be4c6fa7c494189a9
This commit is contained in:
parent
df01af09b9
commit
932f831a25
|
@ -57,7 +57,7 @@
|
||||||
(append (loops rhss) (loop body))]
|
(append (loops rhss) (loop body))]
|
||||||
[(AnyQ p:letrec-syntaxes+values (_ _ _ _ srhss _ vrhss body))
|
[(AnyQ p:letrec-syntaxes+values (_ _ _ _ srhss _ vrhss body))
|
||||||
(append (loops srhss) (loops vrhss) (loop body))]
|
(append (loops srhss) (loops vrhss) (loop body))]
|
||||||
[(AnyQ p:module (_ _ _ body))
|
[(AnyQ p:module (_ _ _ _ body))
|
||||||
(loop body)]
|
(loop body)]
|
||||||
[(AnyQ p:#%module-begin (_ _ _ pass1 pass2))
|
[(AnyQ p:#%module-begin (_ _ _ pass1 pass2))
|
||||||
(append (loops pass1) (loops pass2))]
|
(append (loops pass1) (loops pass2))]
|
||||||
|
|
|
@ -72,7 +72,7 @@
|
||||||
(define-struct (p:unknown p::STOP) () #f)
|
(define-struct (p:unknown p::STOP) () #f)
|
||||||
|
|
||||||
;; Module stuff.... hairy
|
;; Module stuff.... hairy
|
||||||
(define-struct (p:module prule) (body) #f)
|
(define-struct (p:module prule) (one-body-form? body) #f)
|
||||||
(define-struct (p:#%module-begin prule) (pass1 pass2) #f)
|
(define-struct (p:#%module-begin prule) (pass1 pass2) #f)
|
||||||
;; where pass1 is a ModPass1
|
;; where pass1 is a ModPass1
|
||||||
;; and pass2 is a ModPass2
|
;; and pass2 is a ModPass2
|
||||||
|
|
|
@ -217,14 +217,17 @@
|
||||||
;; Modules
|
;; Modules
|
||||||
(PrimModule
|
(PrimModule
|
||||||
(#:args e1 e2 rs)
|
(#:args e1 e2 rs)
|
||||||
|
;; Multiple forms after language
|
||||||
|
;; #%module-begin tagging done automatically
|
||||||
[(prim-module ! (? EE 'body))
|
[(prim-module ! (? EE 'body))
|
||||||
(make-p:module e1 e2 rs $3)]
|
(make-p:module e1 e2 rs #f $3)]
|
||||||
|
|
||||||
;; One form after language ... macro that expands into #%module-begin
|
;; One form after language ... macro that expands into #%module-begin
|
||||||
[(prim-module NoError next
|
[(prim-module NoError next
|
||||||
enter-check (? CheckImmediateMacro/Inner) exit-check
|
enter-check (? CheckImmediateMacro/Inner) exit-check
|
||||||
(! 'module-begin) next (? EE))
|
(! 'module-begin) next (? EE))
|
||||||
(make-p:module e1 e2 rs
|
(make-p:module e1 e2 rs
|
||||||
|
#t
|
||||||
($5 $4
|
($5 $4
|
||||||
(and (deriv? $9) (deriv-e2 $9))
|
(and (deriv? $9) (deriv-e2 $9))
|
||||||
(lambda (ce1 ce2) $9)))])
|
(lambda (ce1 ce2) $9)))])
|
||||||
|
|
|
@ -117,7 +117,7 @@
|
||||||
(struct p:let-values (renames body))
|
(struct p:let-values (renames body))
|
||||||
(struct p:letrec-values (renames rhss body))
|
(struct p:letrec-values (renames rhss body))
|
||||||
(struct p:letrec-syntaxes+values (srenames srhss vrenames vrhss body))
|
(struct p:letrec-syntaxes+values (srenames srhss vrenames vrhss body))
|
||||||
(struct p:module (body))
|
(struct p:module (one-body-form? body))
|
||||||
(struct p:#%module-begin (pass1 pass2))
|
(struct p:#%module-begin (pass1 pass2))
|
||||||
(struct p::STOP ())
|
(struct p::STOP ())
|
||||||
(struct p:#%datum (tagged-stx))
|
(struct p:#%datum (tagged-stx))
|
||||||
|
|
|
@ -28,13 +28,18 @@
|
||||||
;; Primitives
|
;; Primitives
|
||||||
[(struct p:variable (e1 e2 rs))
|
[(struct p:variable (e1 e2 rs))
|
||||||
null]
|
null]
|
||||||
[(IntQ p:module (e1 e2 rs body))
|
[(IntQ p:module (e1 e2 rs #f body))
|
||||||
(with-syntax ([(?module name language . BODY) e1])
|
(with-syntax ([(?module name language . BODY) e1])
|
||||||
(let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))]
|
(let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))]
|
||||||
[body-e1 (match body [($$ deriv (body-e1 _) _) body-e1])])
|
[body-e1 (match body [($$ deriv (body-e1 _) _) body-e1])])
|
||||||
(cons (walk e1 (ctx body-e1) "Tag #%module-begin")
|
(cons (walk e1 (ctx body-e1) "Tag #%module-begin")
|
||||||
(with-context ctx
|
(with-context ctx
|
||||||
(reductions body)))))]
|
(reductions body)))))]
|
||||||
|
[(IntQ p:module (e1 e2 rs #t body))
|
||||||
|
(with-syntax ([(?module name language . BODY) e1])
|
||||||
|
(let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))])
|
||||||
|
(with-context ctx
|
||||||
|
(reductions body))))]
|
||||||
[(IntQ p:#%module-begin (e1 e2 rs pass1 pass2))
|
[(IntQ p:#%module-begin (e1 e2 rs pass1 pass2))
|
||||||
#;(R e1 (?module-begin . MBODY)
|
#;(R e1 (?module-begin . MBODY)
|
||||||
[! exni 'blah]
|
[! exni 'blah]
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
(module trace-raw mzscheme
|
(module trace-raw mzscheme
|
||||||
(require "../syntax-browser/syntax-browser.ss"
|
(require "../syntax-browser.ss"
|
||||||
(lib "class.ss")
|
(lib "class.ss")
|
||||||
(lib "lex.ss" "parser-tools")
|
(lib "lex.ss" "parser-tools")
|
||||||
"deriv-tokens.ss"
|
"deriv-tokens.ss"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user