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

renamed define-struct-hint to black-box-expr, applied to require as well

Browse Source
This commit is contained in:
John Clements 2011-06-29 00:28:08 -07:00
parent 7d782b6fd3
commit d839b9fea6
2 changed files with 33 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/lang/private/teach.rkt
View File

@ -822,7 +822,7 @@
(with-syntax ([(def-proc-name ...) def-proc-names]
[(proc-name ...) proc-names]
[(getter-name ...) getter-names])
(stepper-syntax-property
(stepper-syntax-property
#`(define-values (#,signature-name #,parametric-signature-name def-proc-name ...)
(let ()
@ -935,7 +935,7 @@
sig)))
(values #,signature-name #,parametric-signature-name proc-name ...)))
'stepper-define-struct-hint
'stepper-black-box-expr
stx))))])
(let ([defn
(quasisyntax/loc stx
@ -1484,7 +1484,10 @@
(string? (syntax-e #'s))
(begin
(check-string-form stx #'s)
#'(require s))]
(stepper-syntax-property
#'(require s)
'stepper-black-box-expr
stx))]
[(_ id)
(identifier? #'id)
(begin
@ -1494,7 +1497,9 @@
stx
#'id
"bad syntax for a module path"))
#'(require id))]
(stepper-syntax-property
#'(require id)
'stepper-black-box-expr))]
[(_ (lib . rest))
(let ([s (syntax->list #'rest)])
(unless ((length s) . >= . 2)
@ -1516,7 +1521,10 @@
s)
;; use the original `lib', so that it binds correctly:
(syntax-case stx ()
[(_ ms) #'(require ms)]))]
[(_ ms) (stepper-syntax-property
#'(require ms)
'stepper-black-box-expr
stx)]))]
[(_ (planet . rest))
(syntax-case stx (planet)
[(_ (planet s1 (s2 s3 n1 n2)))
@ -1531,7 +1539,10 @@
(check-string-form stx #'s3)
;; use the original `planet', so that it binds correctly:
(syntax-case stx ()
[(_ ms) #'(require ms)]))]
[(_ ms) (stepper-syntax-property
#'(require ms)
'stepper-black-box-expr
stx)]))]
[_else
(teach-syntax-error
'require

27
collects/stepper/private/annotate.rkt
View File

@ -155,7 +155,7 @@
(cond
[(or (stepper-syntax-property stx 'stepper-skip-completely)
(stepper-syntax-property stx 'stepper-define-struct-hint))
(stepper-syntax-property stx 'stepper-black-box-expr))
stx]
[else
(define rewritten
@ -1235,7 +1235,7 @@
[(stepper-syntax-property exp 'stepper-skip-completely) exp]
;; for kathy's test engine:
[(syntax-property exp 'test-call) exp]
[(stepper-syntax-property exp 'stepper-define-struct-hint)
[(stepper-syntax-property exp 'stepper-black-box-expr)
#`(begin #,exp
(#%plain-app #,(make-define-struct-break exp)))]
[(stepper-syntax-property exp 'stepper-skipto)
@ -1252,19 +1252,24 @@
#`(begin
(define-values (new-var ...)
#,(top-level-annotate/inner (top-level-rewrite #`e) exp defined-name))
;; this next expression should deliver the newly computed values to an exp-finished-break
(#%plain-app #,exp-finished-break (#%plain-app list (#%plain-app list #,(lambda () exp) #f (#%plain-lambda () (#%plain-app list new-var ...))))))
;; this next expression should deliver the newly computed values to an
;; exp-finished-break
(#%plain-app #,exp-finished-break
(#%plain-app list
(#%plain-app list
#,(lambda () exp)
#f
(#%plain-lambda ()
(#%plain-app
list
new-var ...))))))
#'e))]
[(define-syntaxes (new-vars ...) e)
exp]
[(#%require specs ...)
#`(begin #,exp
(#%plain-app #,(make-define-struct-break
(stepper-syntax-property
exp
'stepper-define-struct-hint
;; I hope this actually looks right, and isn't mangled by the expander:
exp))))]
;; this should only include requires inserted automatically, as others should
;; get caught above in the "stepper-black-box-expr" check:
exp]
[(#%provide specs ...)
exp]
[(begin . bodies)