macro stepper: improved 'provide' handling

svn: r12685

original commit: 7fd78779e4e16c9366723b9348761c3b8adb0462
This commit is contained in:
Ryan Culpepper 2008-12-03 05:59:18 +00:00
parent e08317f6c8
commit a194e955ef
3 changed files with 26 additions and 11 deletions

View File

@ -89,6 +89,9 @@
(srenames sbindrhss vrenames vrhss body tag) (srenames sbindrhss vrenames vrhss body tag)
#:transparent) #:transparent)
;; (make-p:provide <Base> (listof Deriv) ?exn)
(define-struct (p:provide prule) (inners ?2) #:transparent)
;; (make-p:stop <Base>) ;; (make-p:stop <Base>)
;; (make-p:unknown <Base>) ;; (make-p:unknown <Base>)
;; (make-p:#%top <Base> Stx) ;; (make-p:#%top <Base> Stx)
@ -98,7 +101,6 @@
;; (make-p:require <Base>) ;; (make-p:require <Base>)
;; (make-p:require-for-syntax <Base>) ;; (make-p:require-for-syntax <Base>)
;; (make-p:require-for-template <Base>) ;; (make-p:require-for-template <Base>)
;; (make-p:provide <Base>)
;; (make-p:#%variable-reference <Base>) ;; (make-p:#%variable-reference <Base>)
(define-struct (p::STOP prule) () #:transparent) (define-struct (p::STOP prule) () #:transparent)
(define-struct (p:stop p::STOP) () #:transparent) (define-struct (p:stop p::STOP) () #:transparent)
@ -110,7 +112,6 @@
(define-struct (p:require p::STOP) () #:transparent) (define-struct (p:require p::STOP) () #:transparent)
(define-struct (p:require-for-syntax p::STOP) () #:transparent) (define-struct (p:require-for-syntax p::STOP) () #:transparent)
(define-struct (p:require-for-template p::STOP) () #:transparent) (define-struct (p:require-for-template p::STOP) () #:transparent)
(define-struct (p:provide p::STOP) () #:transparent)
(define-struct (p:#%variable-reference p::STOP) () #:transparent) (define-struct (p:#%variable-reference p::STOP) () #:transparent)
;; A LDeriv is ;; A LDeriv is

View File

@ -288,8 +288,8 @@
[() [()
(make mod:skip)] (make mod:skip)]
;; provide: special ;; provide: special
[(enter-prim prim-provide (? ModuleProvide/Inner) exit-prim) [(enter-prim prim-provide (? ModuleProvide/Inner) ! exit-prim)
(make mod:cons (make p:provide $1 $4 null $3))] (make mod:cons (make p:provide $1 $5 null #f $3 $4))]
;; normal: expand completely ;; normal: expand completely
[((? EE)) [((? EE))
(make mod:cons $1)] (make mod:cons $1)]
@ -298,10 +298,10 @@
(make mod:lift $1 #f $2)]) (make mod:lift $1 #f $2)])
(ModuleProvide/Inner (ModuleProvide/Inner
[() #f] (#:skipped null)
[(!!) $1] [() null]
[((? EE) (? ModuleProvide/Inner)) [((? EE) (? ModuleProvide/Inner))
$2]) (cons $1 $2)])
;; Definitions ;; Definitions
(PrimDefineSyntaxes (PrimDefineSyntaxes
@ -442,7 +442,7 @@
(PrimProvide (PrimProvide
(#:args e1 e2 rs) (#:args e1 e2 rs)
[(prim-provide !) (make p:provide e1 e2 rs $2)]) [(prim-provide !) (make p:provide e1 e2 rs $2 null #f)])
(PrimVarRef (PrimVarRef
(#:args e1 e2 rs) (#:args e1 e2 rs)

View File

@ -194,9 +194,23 @@
[#:pattern (?top . ?var)] [#:pattern (?top . ?var)]
[#:learn (list #'?var)])] [#:learn (list #'?var)])]
[(Wrap p:provide (e1 e2 rs ?1)) [(Wrap p:provide (e1 e2 rs ?1 inners ?2))
(let ([wrapped-inners
(for/list ([inner inners])
(match inner
[(Wrap deriv (e1 e2))
(make local-expansion e1 e2
#f e1 inner #f e2 #f)]))])
(R [! ?1] (R [! ?1]
[#:walk e2 'provide])] [#:pattern ?form]
[#:pass1]
[#:left-foot]
[LocalActions ?form wrapped-inners]
[! ?2]
[#:pass2]
[#:set-syntax e2]
[#:step 'provide]
[#:set-syntax e2]))]
[(Wrap p:stop (e1 e2 rs ?1)) [(Wrap p:stop (e1 e2 rs ?1))
(R [! ?1])] (R [! ?1])]