macro-stepper: track syntax-local-value and syntax-track-origin (not done)

original commit: dbdf00c5f713ab5eaed70b8e6d35f32b2349aa5c
This commit is contained in:
Ryan Culpepper 2010-07-02 11:02:47 -06:00
parent 4e3fc8fc99
commit 2d29222912
5 changed files with 25 additions and 2 deletions

View File

@ -39,6 +39,8 @@
(define-struct local-lift-require (req expr mexpr) #:transparent) (define-struct local-lift-require (req expr mexpr) #:transparent)
(define-struct local-lift-provide (prov) #:transparent) (define-struct local-lift-provide (prov) #:transparent)
(define-struct local-bind (names ?1 renames bindrhs) #:transparent) (define-struct local-bind (names ?1 renames bindrhs) #:transparent)
(define-struct local-value (name ?1 resolves bound?) #:transparent)
(define-struct track-origin (before after) #:transparent)
(define-struct local-remark (contents) #:transparent) (define-struct local-remark (contents) #:transparent)
;; contents : (listof (U string syntax)) ;; contents : (listof (U string syntax))

View File

@ -43,6 +43,7 @@
enter-check exit-check enter-check exit-check
local-post exit-local exit-local/expr local-post exit-local exit-local/expr
local-bind enter-bind exit-bind local-bind enter-bind exit-bind
local-value-result
phase-up module-body phase-up module-body
renames-lambda renames-lambda
renames-case-lambda renames-case-lambda
@ -201,6 +202,10 @@
(make local-bind $1 $2 $3 #f)] (make local-bind $1 $2 $3 #f)]
[(local-bind rename-list (? BindSyntaxes)) [(local-bind rename-list (? BindSyntaxes))
(make local-bind $1 #f $2 $3)] (make local-bind $1 #f $2 $3)]
[(track-origin)
(make track-origin (car $1) (cdr $1))]
[(local-value ! Resolves local-value-result)
(make local-value $1 $2 $3 $4)]
[(local-remark) [(local-remark)
(make local-remark $1)] (make local-remark $1)]
[(local-artificial-step) [(local-artificial-step)

View File

@ -61,6 +61,10 @@
local-remark ; (listof (U string syntax)) local-remark ; (listof (U string syntax))
local-artificial-step ; (list syntax syntax syntax syntax) local-artificial-step ; (list syntax syntax syntax syntax)
track-origin ; (cons stx stx)
local-value ; identifier
local-value-result ; boolean
)) ))
(define-tokens renames-tokens (define-tokens renames-tokens
@ -175,8 +179,10 @@
(149 prim-varref) (149 prim-varref)
(150 lift-require ,token-lift-require) (150 lift-require ,token-lift-require)
(151 lift-provide ,token-lift-provide) (151 lift-provide ,token-lift-provide)
(155 prim-#%stratified-body) (152 track-origin ,token-track-origin)
)) (153 local-value ,token-local-value)
(154 local-value-result ,token-local-value-result)
(155 prim-#%stratified-body)))
(define (signal->symbol sig) (define (signal->symbol sig)
(if (symbol? sig) (if (symbol? sig)

View File

@ -454,6 +454,15 @@
;; FIXME: use renames ;; FIXME: use renames
[#:binders names] [#:binders names]
[#:when bindrhs => (BindSyntaxes bindrhs)]]] [#:when bindrhs => (BindSyntaxes bindrhs)]]]
[(struct track-origin (before after))
[R [#:set-syntax before]
[#:pattern ?form]
[#:rename ?form after 'track-origin]]]
[(struct local-value (name ?1 resolves bound?))
[R [! ?1]
;; [#:learn (list name)]
;; Add remark step?
]]
[(struct local-remark (contents)) [(struct local-remark (contents))
(R [#:reductions (list (walk/talk 'remark contents))])])) (R [#:reductions (list (walk/talk 'remark contents))])]))

View File

@ -92,6 +92,7 @@
(splice-module-lifts . "Splice lifted module declarations") (splice-module-lifts . "Splice lifted module declarations")
(remark . "Macro made a remark") (remark . "Macro made a remark")
(track-origin . "Macro called syntax-track-origin")
(error . "Error"))) (error . "Error")))