renamed define-struct-hint to black-box-expr, applied to require as well
This commit is contained in:
parent
7d782b6fd3
commit
d839b9fea6
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user