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

fixing the bootstrapping

Browse Source
This commit is contained in:
dyoo 2011-03-15 14:20:01 -04:00
parent 54ee4e8da4
commit a17434937b
2 changed files with 40 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
simulator.rkt
View File

@ -29,29 +29,38 @@
(define current-simulated-output-port (make-parameter (current-output-port)))
(: new-machine ((Listof Statement) -> machine))
(define (new-machine program-text)
(let*: ([after-bootstrapping : Symbol (make-label 'afterBootstrapping)]
[program-text : (Listof Statement)
(append `(,(make-GotoStatement (make-Label after-bootstrapping)))
(make-call/cc-code)
`(,after-bootstrapping)
program-text)])
(let: ([m : machine (make-machine (make-undefined)
(make-undefined)
'()
'()
0
(list->vector program-text)
0
((inst make-hash Symbol Natural)))])
(let: loop : Void ([i : Natural 0])
(when (< i (vector-length (machine-text m)))
(let: ([stmt : Statement (vector-ref (machine-text m) i)])
(when (symbol? stmt)
(hash-set! (machine-jump-table m) stmt i))
(loop (add1 i)))))
m)))
(: new-machine (case-lambda [(Listof Statement) -> machine]
[(Listof Statement) Boolean -> machine]))
(define new-machine
(case-lambda:
[([program-text : (Listof Statement)])
(new-machine program-text #t)]
[([program-text : (Listof Statement)]
[with-bootstrapping-code? : Boolean])
(let*: ([after-bootstrapping : Symbol (make-label 'afterBootstrapping)]
[program-text : (Listof Statement)
(cond [with-bootstrapping-code?
(append `(,(make-GotoStatement (make-Label after-bootstrapping)))
(make-call/cc-code)
`(,after-bootstrapping)
program-text)]
[else
program-text])])
(let: ([m : machine (make-machine (make-undefined)
(make-undefined)
'()
'()
0
(list->vector program-text)
0
((inst make-hash Symbol Natural)))])
(let: loop : Void ([i : Natural 0])
(when (< i (vector-length (machine-text m)))
(let: ([stmt : Statement (vector-ref (machine-text m) i)])
(when (symbol? stmt)
(hash-set! (machine-jump-table m) stmt i))
(loop (add1 i)))))
m))]))

12
test-simulator.rkt
View File

@ -42,7 +42,8 @@
;; Infinite loop
(let ([m (new-machine `(hello world ,(make-GotoStatement (make-Label 'hello))))])
(let ([m (new-machine `(hello world ,(make-GotoStatement (make-Label 'hello)))
#f)])
(test (machine-pc (step-n m 0)) 0)
(test (machine-pc (step-n m 1)) 1)
(test (machine-pc (step-n m 1)) 2)
@ -52,13 +53,15 @@
;; Assigning to val
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const 42))))])
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const 42)))
#f)])
(test (machine-val m) (make-undefined))
(step! m)
(test (machine-val m) 42))
;; Assigning to proc
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const 42))))])
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const 42)))
#f)])
(test (machine-proc m) (make-undefined))
(step! m)
(test (machine-proc m) 42))
@ -66,7 +69,8 @@
;; Assigning to a environment reference
(let* ([m (new-machine `(,(make-PushEnvironment 1 #f)
,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 42))))]
,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const 42)))
#f)]
[m (run m)])
(test (machine-env m) '(42)))