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

Let's just make some differently painted identifiers so that some

Browse Source 
error messages won't reveal the non-similarly-named ids behind the
curtain.

(I have my hammer, and damn if I won't use it.)

svn: r13107
This commit is contained in:
Stevie Strickland 2009-01-14 03:14:26 +00:00
parent 5e325a6552
commit 12fc114993
1 changed files with 34 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
collects/mzlib/unit.ss
View File

@ -707,39 +707,40 @@
(var-info-id defid))))) (var-info-id defid)))))
(syntax->list (localify #'ivars def-ctx))) (syntax->list (localify #'ivars def-ctx)))
(with-syntax ([(defn-or-expr ...) (let ([marker (make-syntax-introducer)])
(apply append (with-syntax ([(defn-or-expr ...)
(map (λ (defn-or-expr) (apply append
(syntax-case defn-or-expr (define-values) (map (λ (defn-or-expr)
[(define-values (id ...) body) (syntax-case defn-or-expr (define-values)
(let* ([ids (syntax->list #'(id ...))] [(define-values (id ...) body)
[tmps (generate-temporaries ids)] (let* ([ids (syntax->list #'(id ...))]
[do-one [tmps (map marker ids)]
(λ (id tmp) [do-one
(let ([var-info (bound-identifier-mapping-get (λ (id tmp)
defined-names-table (let ([var-info (bound-identifier-mapping-get
id)]) defined-names-table
(cond id)])
[(var-info-exported? var-info) (cond
=> [(var-info-exported? var-info)
(λ (export-loc) =>
(let ([add-ctc (var-info-add-ctc var-info)]) (λ (export-loc)
(list (quasisyntax/loc defn-or-expr (let ([add-ctc (var-info-add-ctc var-info)])
(set-box! #,export-loc (list (quasisyntax/loc defn-or-expr
(let ([#,id #,(if add-ctc (add-ctc tmp) tmp)]) (set-box! #,export-loc
#,id))) (let ([#,id #,(if add-ctc (add-ctc tmp) tmp)])
(quasisyntax/loc defn-or-expr #,id)))
(define-syntax #,id (quasisyntax/loc defn-or-expr
(make-id-mapper (quote-syntax #,tmp)))))))] (define-syntax #,id
[else (list (quasisyntax/loc defn-or-expr (make-id-mapper (quote-syntax #,tmp)))))))]
(define-syntax #,id [else (list (quasisyntax/loc defn-or-expr
(make-rename-transformer (quote-syntax #,tmp)))))])))]) (define-syntax #,id
(cons (quasisyntax/loc defn-or-expr (make-rename-transformer (quote-syntax #,tmp)))))])))])
(define-values #,tmps body)) (cons (quasisyntax/loc defn-or-expr
(apply append (map do-one ids tmps))))] (define-values #,tmps body))
[else (list defn-or-expr)])) (apply append (map do-one ids tmps))))]
expanded-body))]) [else (list defn-or-expr)]))
#'(begin-with-definitions defn-or-expr ...))))))) expanded-body))])
#'(begin-with-definitions defn-or-expr ...))))))))
(define-for-syntax (redirect-imports/exports import?) (define-for-syntax (redirect-imports/exports import?)
(lambda (table-stx (lambda (table-stx