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

continuing to debug

Browse Source
This commit is contained in:
Danny Yoo 2011-04-01 23:26:22 -04:00
parent d1b27940b7
commit 1f012fb570
4 changed files with 20 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bootstrapped-primitives.rkt
View File

@ -68,9 +68,7 @@
(define (make-bootstrapped-primitive-code name src) (define (make-bootstrapped-primitive-code name src)
(parameterize ([current-defined-name name]) (parameterize ([current-defined-name name])
(append (append
(compile (parse src) (make-PrimitivesReference name) next-linkage) (compile (parse src) (make-PrimitivesReference name) next-linkage))))
;; Remove the prefix after the Primitives assignment.
`(,(make-PopEnvironment 1 0)))))

22
compile.rkt
View File

@ -24,16 +24,18 @@
(let ([after-lam-bodies (make-label 'afterLamBodies)] (let ([after-lam-bodies (make-label 'afterLamBodies)]
[before-pop-prompt (make-label 'beforePopPrompt)]) [before-pop-prompt (make-label 'beforePopPrompt)])
(statements (statements
(append-instruction-sequences (make-instruction-sequence (append-instruction-sequences
`(,(make-GotoStatement (make-Label after-lam-bodies))))
(compile-lambda-bodies (collect-all-lams exp)) (make-instruction-sequence
after-lam-bodies `(,(make-GotoStatement (make-Label after-lam-bodies))))
(compile-lambda-bodies (collect-all-lams exp))
(make-instruction-sequence after-lam-bodies
`(,(make-PushControlFrame/Prompt default-continuation-prompt-tag
before-pop-prompt))) (make-instruction-sequence
(compile exp '() target prompt-linkage) `(,(make-PushControlFrame/Prompt default-continuation-prompt-tag
before-pop-prompt)))) before-pop-prompt)))
(compile exp '() target prompt-linkage)
before-pop-prompt))))
(define-struct: lam+cenv ([lam : Lam] (define-struct: lam+cenv ([lam : Lam]
[cenv : CompileTimeEnvironment])) [cenv : CompileTimeEnvironment]))

6
simulator-primitives.rkt
View File

@ -119,6 +119,10 @@
(apply newline args) (apply newline args)
the-void-value)) the-void-value))
(define my-vector-set! (lambda args
(apply vector-set! args)
the-void-value))
(define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >= (define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >=
sub1 sub1
@ -156,7 +160,7 @@
(my-set-box! set-box!) (my-set-box! set-box!)
vector vector
vector-set! (my-vector-set! vector-set!)
vector-ref vector-ref
(my-vector->list vector->list) (my-vector->list vector->list)
(my-list->vector list->vector) (my-list->vector list->vector)

4
test-conform.rkt
View File

@ -51,12 +51,12 @@
(begin (begin
(printf "Running... \n") (printf "Running... \n")
(let*-values([(a-machine num-steps) (let*-values([(a-machine num-steps)
(run (new-machine (run-compiler code)) options ...)] (run (new-machine (run-compiler code) #t) options ...)]
[(actual) (machine-val a-machine)]) [(actual) (machine-val a-machine)])
(printf "ok. ~s steps.\n\n" num-steps)))))])) (printf "ok. ~s steps.\n\n" num-steps)))))]))
(test (read (open-input-file "tests/conform/program0.sch")) (test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")) (port->string (open-input-file "tests/conform/expected0.txt"))
;#:debug? #t ;;#:debug? #t
) )