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

bug report 10129

Browse Source 
svn: r14127
This commit is contained in:
Matthias Felleisen 2009-03-16 14:50:13 +00:00
parent 1547638f3b
commit ef85043b9a
1 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/2htdp/universe.ss
View File

@ -146,15 +146,18 @@
(syntax-case #'E ()
[(V) (set! rec? #'V)]
[_ (err 'record? stx)]))
(cons (syntax-e #'kw) (syntax E)))]
(cons #'kw #;(syntax-e #'kw) (syntax E)))]
[_ (raise-syntax-error
'big-bang "not a legal big-bang clause" stx)]))
(syntax->list (syntax (s ...))))]
;; assert: all bind = (kw . E) and kw is constrained via Bind
[args (map (lambda (x)
(define kw (car x))
(define co (assq kw Spec))
(list kw ((cadr co) (cdr x))))
(define co ;; patch from Jay to allow rename on import
(findf (lambda (n) (free-identifier=? kw (car n)))
(map (lambda (k s) (cons k (cdr s)))
kwds Spec)))
(list (syntax-e (car co)) ((cadr co) (cdr x))))
spec)])
#`(send (new (if #,rec? aworld% world%) [world0 w] #,@args) last))]))
@ -276,7 +279,7 @@
[(kw . E)
(and (identifier? #'kw)
(for/or ([n kwds]) (free-identifier=? #'kw n)))
(cons (syntax-e #'kw) (syntax E))]
(cons #'kw (syntax E))]
[(kw E)
(and (identifier? #'kw)
(for/or ([n kwds]) (free-identifier=? #'kw n)))
@ -285,6 +288,15 @@
'universe "not a legal universe clause" stx)]))
(syntax->list (syntax (bind ...))))]
;; assert: all bind = (kw . E) and kw is constrained via Bind
[args (map (lambda (x)
(define kw (car x))
(define co ;; patch from Jay to allow rename on import
(findf (lambda (n) (free-identifier=? kw (car n)))
(map (lambda (k s) (cons k (cdr s)))
kwds Spec)))
(list (syntax-e (car co)) ((cadr co) (cdr x))))
spec)]
#;
[args (map (lambda (x)
(define kw (car x))
(define co (assq kw Spec))