Base now works, but was broken before
This commit is contained in:
parent
a460ab960c
commit
e6e95f1029
|
@ -9,7 +9,7 @@
|
|||
"nodep.rkt"
|
||||
"update-toplevels.rkt")
|
||||
|
||||
(define MODULE-TOPLEVEL-OFFSETS (make-hash))
|
||||
(define MODULE-TOPLEVEL-OFFSETS (make-hasheq))
|
||||
|
||||
(define current-get-modvar-rewrite (make-parameter #f))
|
||||
(define (merge-compilation-top get-modvar-rewrite top)
|
||||
|
@ -61,16 +61,20 @@
|
|||
(append root-toplevels mod-toplevels)
|
||||
(append root-stxs mod-stxs))])]))
|
||||
|
||||
(struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent)
|
||||
|
||||
(define (compute-new-modvar mv rw)
|
||||
(match mv
|
||||
[(struct module-variable (modidx sym pos phase constantness))
|
||||
(match rw
|
||||
[(struct modvar-rewrite (self-modidx provide->toplevel))
|
||||
(log-debug (format "Rewriting ~a of ~S" pos (mpi->path* modidx)))
|
||||
((hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
|
||||
(match-define (toplevel-offset-rewriter rewrite-fun meta)
|
||||
(hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
|
||||
(lambda ()
|
||||
(error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx)))
|
||||
(provide->toplevel sym pos))])]))
|
||||
(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))
|
||||
(rewrite-fun (provide->toplevel sym pos))])]))
|
||||
|
||||
(define (filter-rewritable-module-variable? toplevel-offset mod-toplevels)
|
||||
(define-values
|
||||
|
@ -119,7 +123,8 @@
|
|||
(define topsyntax-offset (length (prefix-stxs top-prefix)))
|
||||
(define lift-offset (prefix-num-lifts top-prefix))
|
||||
(define mod-toplevels (prefix-toplevels mod-prefix))
|
||||
(define-values (new-mod-toplevels toplevel-remap) (filter-rewritable-module-variable? toplevel-offset mod-toplevels))
|
||||
(define-values (new-mod-toplevels toplevel-remap)
|
||||
(filter-rewritable-module-variable? toplevel-offset mod-toplevels))
|
||||
(define num-mod-toplevels
|
||||
(length toplevel-remap))
|
||||
(define mod-stxs
|
||||
|
@ -129,9 +134,16 @@
|
|||
(define new-mod-prefix
|
||||
(struct-copy prefix mod-prefix
|
||||
[toplevels new-mod-toplevels]))
|
||||
(define offset-meta (vector name srcname self-modidx))
|
||||
(log-debug "Setting toplevel offsets rewriter for ~S and it is currently ~S"
|
||||
offset-meta
|
||||
(hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx #f))
|
||||
(hash-set! MODULE-TOPLEVEL-OFFSETS self-modidx
|
||||
(toplevel-offset-rewriter
|
||||
(lambda (n)
|
||||
(list-ref toplevel-remap n)))
|
||||
(log-debug "Finding offset ~a in ~S of ~S" n toplevel-remap offset-meta)
|
||||
(list-ref toplevel-remap n))
|
||||
offset-meta))
|
||||
(unless (= (length toplevel-remap)
|
||||
(length mod-toplevels))
|
||||
(error 'merge-module "Not remapping everything: ~S ~S"
|
||||
|
|
|
@ -128,10 +128,13 @@
|
|||
(when (symbol? tl)
|
||||
(hash-set! provide-ht (intern tl) i)))
|
||||
(lambda (sym pos)
|
||||
(log-debug (format "Looking up ~S@~a" sym pos))
|
||||
(log-debug (format "Looking up ~S@~a in ~S" sym pos prefix))
|
||||
(define res
|
||||
(hash-ref provide-ht (intern sym)
|
||||
(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))
|
||||
res))
|
||||
|
||||
(define (nodep-module mod-form phase)
|
||||
(match mod-form
|
||||
|
|
|
@ -13,7 +13,7 @@
|
|||
(values (get-output-string o) (get-output-string e)))
|
||||
|
||||
(define (test-on-program filename)
|
||||
; run modular program, capture output
|
||||
;; run modular program, capture output
|
||||
(define-values (modular-output modular-error)
|
||||
(capture-output (find-exe) filename))
|
||||
|
||||
|
@ -24,15 +24,15 @@
|
|||
(find-system-path 'temp-dir)
|
||||
(path-add-suffix filename #"_merged.zo")))))
|
||||
|
||||
; demodularize
|
||||
;; demodularize
|
||||
(parameterize ([current-input-port (open-input-string "")])
|
||||
(system* (find-exe) "-l-" "raco" "demod" "-o" demod-filename filename))
|
||||
|
||||
; run whole program
|
||||
;; run whole program
|
||||
(define-values (whole-output whole-error)
|
||||
(capture-output (find-exe) demod-filename))
|
||||
|
||||
; compare output
|
||||
;; compare output
|
||||
(test
|
||||
#:failure-prefix (format "~a stdout" filename)
|
||||
whole-output => modular-output
|
||||
|
|
|
@ -0,0 +1,2 @@
|
|||
#lang racket/base
|
||||
5
|
Loading…
Reference in New Issue
Block a user