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

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

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