From ef85043b9a9d21a47452c49bd2648a48d9088c7e Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Mon, 16 Mar 2009 14:50:13 +0000 Subject: [PATCH] bug report 10129 svn: r14127 --- collects/2htdp/universe.ss | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/collects/2htdp/universe.ss b/collects/2htdp/universe.ss index d4d4d80981..601f08f949 100644 --- a/collects/2htdp/universe.ss +++ b/collects/2htdp/universe.ss @@ -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))