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

fixing closure problem

Browse Source
This commit is contained in:
Blake Johnson 2010-08-27 15:36:45 -06:00 committed by Jay McCarthy
parent ecc9ceb842
commit 2dfaab00f4
3 changed files with 80 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/compiler/zo-marshal.rkt
View File

@ -87,7 +87,7 @@
(define (shared-obj-pos/modulo-v v) (define (shared-obj-pos/modulo-v v)
(define skip? #t) (define skip? #t)
(λ (v2 #:share [share? #t]) (λ (v2 #:share [share? #t])
(if (and skip? (eq? v v2) (not (closure? v2))) (if (and skip? (eq? v v2) #;(not (closure? v2)))
(begin (begin
(set! skip? #f) (set! skip? #f)
#f) #f)

14
collects/compiler/zo-parse.rkt
View File

@ -941,12 +941,14 @@
[ind (make-indirect #f)]) [ind (make-indirect #f)])
(symtab-write! cp l ind) (symtab-write! cp l ind)
(let* ([v (read-compact cp)] (let* ([v (read-compact cp)]
[cl (make-closure v (gensym [cl (make-closure v
(let ([s (lam-name v)]) ; XXX Why call gensym here?
(cond (gensym
[(symbol? s) s] (let ([s (lam-name v)])
[(vector? s) (vector-ref s 0)] (cond
[else 'closure]))))]) [(symbol? s) s]
[(vector? s) (vector-ref s 0)]
[else 'closure]))))])
(set-indirect-v! ind cl) (set-indirect-v! ind cl)
ind))] ind))]
[(svector) [(svector)

132
collects/tests/compiler/zo-exs.rkt
View File

@ -20,86 +20,86 @@
(test (test
#;(roundtrip #;(roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(list 1 (list 2 3) (list 2 3) 4 5))) (list 1 (list 2 3) (list 2 3) 4 5)))
(roundtrip (roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(let* ([ph (make-placeholder #f)] (let* ([ph (make-placeholder #f)]
[x (closure [x (indirect (closure
(lam 'name (lam 'name
empty empty
0 0
empty empty
#f #f
#() #()
empty empty
0 0
ph) ph)
(gensym))]) 'name))])
(placeholder-set! ph x) (placeholder-set! ph x)
(make-reader-graph x)))) (make-reader-graph x))))
#;(roundtrip #;(roundtrip
(compilation-top (compilation-top
0 0
(prefix 0 (list #f) (list)) (prefix 0 (list #f) (list))
(mod (mod
'simple 'simple
'simple 'simple
(module-path-index-join #f #f) (module-path-index-join #f #f)
(prefix (prefix
0 0
(list (module-variable (list (module-variable
(module-path-index-join (module-path-index-join
"modbeg.rkt" "modbeg.rkt"
(module-path-index-join (module-path-index-join
"pre-base.rkt" "pre-base.rkt"
(module-path-index-join (module-path-index-join
"namespace.rkt" "namespace.rkt"
(module-path-index-join "private/base.rkt" (module-path-index-join 'racket/base #f))))) 'print-values 0 0)) (module-path-index-join "private/base.rkt" (module-path-index-join 'racket/base #f))))) 'print-values 0 0))
(list)) (list))
(list) (list)
(list (list 0 (module-path-index-join 'racket/base #f)) (list 1) (list -1) (list #f)) (list (list 0 (module-path-index-join 'racket/base #f)) (list 1) (list -1) (list #f))
(list (apply-values (list (apply-values
(toplevel 0 0 #f #t) (toplevel 0 0 #f #t)
(application (application
(primval 231) (primval 231)
(list 1 'a)))) (list 1 'a))))
(list) (list)
(list (list) (list) (list)) (list (list) (list) (list))
2 2
(toplevel 0 0 #f #f) (toplevel 0 0 #f #f)
#(racket/language-info get-info #f) #(racket/language-info get-info #f)
#t))) #t)))
#;(roundtrip #;(roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(current-directory))) (current-directory)))
#;(roundtrip #;(roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(list (current-directory)))) (list (current-directory))))
#;(roundtrip #;(roundtrip
(compilation-top (compilation-top
0 0
(prefix 0 empty empty) (prefix 0 empty empty)
(cons #hasheq() (cons #hasheq()
#hasheq()))) #hasheq())))
#;(local [(define (hash-test make-hash-placeholder) #;(local [(define (hash-test make-hash-placeholder)
(roundtrip (roundtrip
(compilation-top 0 (compilation-top 0
(prefix 0 empty empty) (prefix 0 empty empty)
(local [(define ht-ph (make-placeholder #f)) (local [(define ht-ph (make-placeholder #f))
(define ht (make-hash-placeholder (list (cons 'g ht-ph))))] (define ht (make-hash-placeholder (list (cons 'g ht-ph))))]
(placeholder-set! ht-ph ht) (placeholder-set! ht-ph ht)
(make-reader-graph ht)))))] (make-reader-graph ht)))))]
(hash-test make-hash-placeholder) (hash-test make-hash-placeholder)
(hash-test make-hasheq-placeholder) (hash-test make-hasheq-placeholder)
(hash-test make-hasheqv-placeholder))) (hash-test make-hasheqv-placeholder)))