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

work around debugger problem with gen-temp ids

Browse Source 
svn: r734
This commit is contained in:
Matthew Flatt 2005-09-01 17:05:13 +00:00
parent 76ae386773
commit d232a9f491
1 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/plai/private/datatype-core.ss
View File

@ -14,6 +14,14 @@
cases-core cases-core
provide-datatype-core) provide-datatype-core)
;; Temporary workaround for problem in debugger:
(define-for-syntax (generate-dt-temporaries l)
(if (list? l)
(map (lambda (x)
(gensym (if (symbol? x) x (syntax-e x))))
l)
(generate-dt-temporaries (syntax->list l))))
(define (projection-contract name proc) (define (projection-contract name proc)
(let ([name `(,(car name) ,@(map (lambda (c) (let ([name `(,(car name) ,@(map (lambda (c)
(if (contract? c) (if (contract? c)
@ -102,7 +110,7 @@
(datum->syntax-object (quote-syntax here) n #f)) (datum->syntax-object (quote-syntax here) n #f))
(map length field-nameses))] (map length field-nameses))]
[(variant-name/no-contract ...) [(variant-name/no-contract ...)
(generate-temporaries variant-names)] (generate-dt-temporaries variant-names)]
[(variant-of ...) [(variant-of ...)
(map (lambda (variant-name) (map (lambda (variant-name)
(datum->syntax-object variant-name (datum->syntax-object variant-name
@ -133,11 +141,11 @@
(format "~a-accessor" (syntax-e vn))))) (format "~a-accessor" (syntax-e vn)))))
variant-names)] variant-names)]
[(variant-mutator ...) [(variant-mutator ...)
(generate-temporaries variant-names)] (generate-dt-temporaries variant-names)]
[(make-variant ...) [(make-variant ...)
(generate-temporaries variant-names)] (generate-dt-temporaries variant-names)]
[(struct:variant ...) [(struct:variant ...)
(generate-temporaries variant-names)] (generate-dt-temporaries variant-names)]
[((selector-name ...) ...) [((selector-name ...) ...)
(map (lambda (variant-name field-names) (map (lambda (variant-name field-names)
(if (memq 'define-selectors options) (if (memq 'define-selectors options)
@ -154,7 +162,7 @@
field-nameses)] field-nameses)]
[((sub-contract-proc ...) ...) [((sub-contract-proc ...) ...)
(map (lambda (field-names) (map (lambda (field-names)
(generate-temporaries field-names)) (generate-dt-temporaries field-names))
field-nameses)] field-nameses)]
[((field-pos ...) ...) [((field-pos ...) ...)
(map (lambda (field-names) (map (lambda (field-names)