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

Racket now works, but was broken before

Browse Source
This commit is contained in:
Jay McCarthy 2013-10-15 08:26:57 -06:00
parent e6e95f1029
commit 11b784236e
3 changed files with 18 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/compiler-lib/compiler/demodularizer/main.rkt
View File

@ -35,7 +35,7 @@
(path-add-suffix file-to-batch #"_merged.zo"))) (path-add-suffix file-to-batch #"_merged.zo")))
;; Transformations ;; Transformations
(define path-cache (make-hash)) (define path-cache (make-hasheq))
(log-info "Removing dependencies") (log-info "Removing dependencies")
(define-values (batch-nodep top-lang-info top-self-modidx get-modvar-rewrite) (define-values (batch-nodep top-lang-info top-self-modidx get-modvar-rewrite)
@ -74,4 +74,4 @@
merged-zo-path merged-zo-path
(lambda () (lambda ()
(zo-marshal-to batch-mod (current-output-port))) (zo-marshal-to batch-mod (current-output-port)))
#:exists 'replace)))) #:exists 'replace))))

13
pkgs/compiler-lib/compiler/demodularizer/merge.rkt
View File

@ -68,13 +68,18 @@
[(struct module-variable (modidx sym pos phase constantness)) [(struct module-variable (modidx sym pos phase constantness))
(match rw (match rw
[(struct modvar-rewrite (self-modidx provide->toplevel)) [(struct modvar-rewrite (self-modidx provide->toplevel))
(log-debug (format "Rewriting ~a of ~S" pos (mpi->path* modidx))) (log-debug (format "Rewriting ~a@~a of ~S" sym pos (mpi->path* modidx)))
(define tl (provide->toplevel sym pos))
(log-debug (format "Rewriting ~a@~a of ~S to ~S" sym pos (mpi->path* modidx) tl))
(match-define (toplevel-offset-rewriter rewrite-fun meta) (match-define (toplevel-offset-rewriter rewrite-fun meta)
(hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
(lambda () (lambda ()
(error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx)))) (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx))))
(log-debug (format "Rewriting ~a of ~S from ~S" pos (mpi->path* modidx) meta)) (log-debug (format "Rewriting ~a@~a of ~S (which is ~a) with ~S" sym pos (mpi->path* modidx) tl meta))
(rewrite-fun (provide->toplevel sym pos))])])) (define res (rewrite-fun tl))
(log-debug (format "Rewriting ~a@~a of ~S (which is ~a) with ~S and got ~S"
sym pos (mpi->path* modidx) tl meta res))
res])]))
(define (filter-rewritable-module-variable? toplevel-offset mod-toplevels) (define (filter-rewritable-module-variable? toplevel-offset mod-toplevels)
(define-values (define-values
@ -86,7 +91,7 @@
(match tl (match tl
[(and mv (struct module-variable (modidx sym pos phase constantness))) [(and mv (struct module-variable (modidx sym pos phase constantness)))
(define rw ((current-get-modvar-rewrite) modidx)) (define rw ((current-get-modvar-rewrite) modidx))
; XXX We probably don't need to deal with #f phase ;; XXX We probably don't need to deal with #f phase
(unless (or (not phase) (zero? phase)) (unless (or (not phase) (zero? phase))
(error 'eliminate-module-variables "Non-zero phases not supported: ~S" mv)) (error 'eliminate-module-variables "Non-zero phases not supported: ~S" mv))
(cond (cond

12
pkgs/compiler-lib/compiler/demodularizer/nodep.rkt
View File

@ -124,13 +124,14 @@
(define (construct-provide->toplevel prefix provides) (define (construct-provide->toplevel prefix provides)
(define provide-ht (make-hasheq)) (define provide-ht (make-hasheq))
(for ([tl (prefix-toplevels prefix)] (for ([tl (prefix-toplevels prefix)]
[i (in-naturals)]) [i (in-naturals)])
(when (symbol? tl) (when (symbol? tl)
(hash-set! provide-ht (intern tl) i))) (hash-set! provide-ht (intern tl) i)))
(lambda (sym pos) (lambda (sym pos)
(log-debug (format "Looking up ~S@~a in ~S" sym pos prefix)) (define isym (intern sym))
(log-debug (format "Looking up ~S@~a [~S] in ~S" sym pos isym prefix))
(define res (define res
(hash-ref provide-ht (intern sym) (hash-ref provide-ht isym
(lambda () (lambda ()
(error 'provide->toplevel "Cannot find ~S in ~S" sym prefix)))) (error 'provide->toplevel "Cannot find ~S in ~S" sym prefix))))
(log-debug (format "Looked up ~S@~a and got ~v" sym pos res)) (log-debug (format "Looked up ~S@~a and got ~v" sym pos res))
@ -142,14 +143,15 @@
unexported max-let-depth dummy lang-info internal-context unexported max-let-depth dummy lang-info internal-context
flags pre-submodules post-submodules)) flags pre-submodules post-submodules))
(define new-prefix prefix) (define new-prefix prefix)
; Cache all the mpi paths ;; Cache all the mpi paths
(for-each (match-lambda (for-each (match-lambda
[(and mv (struct module-variable (modidx sym pos phase constantness))) [(and mv (struct module-variable (modidx sym pos phase constantness)))
(mpi->path! modidx)] (mpi->path! modidx)]
[tl [tl
(void)]) (void)])
(prefix-toplevels new-prefix)) (prefix-toplevels new-prefix))
(log-debug (format "[~S] module-variables: ~S" name (length (filter module-variable? (prefix-toplevels new-prefix))))) (define mvs (filter module-variable? (prefix-toplevels new-prefix)))
(log-debug (format "[~S] module-variables: ~S - ~S" name (length mvs) mvs))
(values (make-modvar-rewrite self-modidx (construct-provide->toplevel new-prefix provides)) (values (make-modvar-rewrite self-modidx (construct-provide->toplevel new-prefix provides))
lang-info lang-info
(append (requires->modlist requires phase) (append (requires->modlist requires phase)