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

changed representation of stepper-skipto lists

Browse Source 
svn: r4422
This commit is contained in:
John Clements 2006-09-23 10:44:40 +00:00
parent ee4cbbb1e3
commit 66298f0727
2 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/lang/private/teach.ss
View File

@ -95,7 +95,7 @@
;; A consistent pattern for stepper-skipto: ;; A consistent pattern for stepper-skipto:
(define-for-syntax (stepper-ignore-checker stx) (define-for-syntax (stepper-ignore-checker stx)
(syntax-property stx 'stepper-skipto (list syntax-e cdr syntax-e cdr car))) (syntax-property stx 'stepper-skipto '(syntax-e cdr syntax-e cdr car)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; syntax implementations ;; syntax implementations
@ -279,7 +279,7 @@
(define (ensure-expression stx k) (define (ensure-expression stx k)
(if (memq (syntax-local-context) '(expression)) (if (memq (syntax-local-context) '(expression))
(k) (k)
(syntax-property #`(begin0 #,stx) 'stepper-skipto (list syntax-e cdr car)))) (syntax-property #`(begin0 #,stx) 'stepper-skipto '(syntax-e cdr car))))
;; Use to generate nicer error messages than direct pattern ;; Use to generate nicer error messages than direct pattern
;; matching. The `where' argument is an English description ;; matching. The `where' argument is an English description
@ -1310,7 +1310,7 @@
(syntax-property (syntax-property
#`(let () expr) #`(let () expr)
'stepper-skipto 'stepper-skipto
(list syntax-e cdr cdr car))] '(syntax-e cdr cdr car))]
[(_ ([name0 rhs-expr0] [name rhs-expr] ...) expr) [(_ ([name0 rhs-expr0] [name rhs-expr] ...) expr)
(let ([names (syntax->list (syntax (name0 name ...)))]) (let ([names (syntax->list (syntax (name0 name ...)))])
(andmap identifier/non-kw? names)) (andmap identifier/non-kw? names))
@ -1655,7 +1655,7 @@
(syntax-property (syntax-property
(syntax/loc stx (time . exprs)) (syntax/loc stx (time . exprs))
'stepper-skipto 'stepper-skipto
(list syntax-e cdr car syntax-e car syntax-e cdr car syntax-e cdr syntax-e cdr car syntax-e cdr cdr car))] '(syntax-e cdr car syntax-e car syntax-e cdr car syntax-e cdr syntax-e cdr car syntax-e cdr cdr car))]
[_else [_else
(bad-use-error 'time stx)])))) (bad-use-error 'time stx)]))))
@ -1831,7 +1831,7 @@
(syntax-property (syntax-property
(syntax/loc stx (begin (set! id expr ...) set!-result)) (syntax/loc stx (begin (set! id expr ...) set!-result))
'stepper-skipto 'stepper-skipto
(list syntax-e cdr syntax-e car)) '(syntax-e cdr syntax-e car))
(stepper-ignore-checker (syntax/loc stx (#%app values (advanced-set!-continue id expr ...))))))] (stepper-ignore-checker (syntax/loc stx (#%app values (advanced-set!-continue id expr ...))))))]
[(_ id . __) [(_ id . __)
(teach-syntax-error (teach-syntax-error

4
collects/lang/private/teachhelp.ss
View File

@ -24,7 +24,7 @@
(list 'quote (syntax id)) (list 'quote (syntax id))
tmp-id)) tmp-id))
'stepper-skipto 'stepper-skipto
(list syntax-e cdr syntax-e cdr cdr car)) '(syntax-e cdr syntax-e cdr cdr car))
(syntax args)) (syntax args))
stx)] stx)]
[id [id
@ -36,7 +36,7 @@
tmp-id) tmp-id)
stx) stx)
'stepper-skipto 'stepper-skipto
(list syntax-e cdr syntax-e cdr cdr car))]))))) ; this may make other stepper-skipto annotations obsolete. '(syntax-e cdr syntax-e cdr cdr car))]))))) ; this may make other stepper-skipto annotations obsolete.
(define (appropriate-use what) (define (appropriate-use what)
(case what (case what