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)
(parameterize ([current-defined-name name])
(append
(compile (parse src) (make-PrimitivesReference name) next-linkage)
;; Remove the prefix after the Primitives assignment.
`(,(make-PopEnvironment 1 0)))))
(compile (parse src) (make-PrimitivesReference name) next-linkage))))

22
compile.rkt
View File

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

6
simulator-primitives.rkt
View File

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

4
test-conform.rkt
View File

@ -51,12 +51,12 @@
(begin
(printf "Running... \n")
(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)])
(printf "ok. ~s steps.\n\n" num-steps)))))]))
(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt"))
;#:debug? #t
;;#:debug? #t
)