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))) (define current-simulated-output-port (make-parameter (current-output-port)))
(: new-machine ((Listof Statement) -> machine)) (: new-machine (case-lambda [(Listof Statement) -> machine]
(define (new-machine program-text) [(Listof Statement) Boolean -> machine]))
(let*: ([after-bootstrapping : Symbol (make-label 'afterBootstrapping)] (define new-machine
[program-text : (Listof Statement) (case-lambda:
(append `(,(make-GotoStatement (make-Label after-bootstrapping))) [([program-text : (Listof Statement)])
(make-call/cc-code) (new-machine program-text #t)]
`(,after-bootstrapping) [([program-text : (Listof Statement)]
program-text)]) [with-bootstrapping-code? : Boolean])
(let: ([m : machine (make-machine (make-undefined) (let*: ([after-bootstrapping : Symbol (make-label 'afterBootstrapping)]
(make-undefined) [program-text : (Listof Statement)
'() (cond [with-bootstrapping-code?
'() (append `(,(make-GotoStatement (make-Label after-bootstrapping)))
0 (make-call/cc-code)
(list->vector program-text) `(,after-bootstrapping)
0 program-text)]
((inst make-hash Symbol Natural)))]) [else
(let: loop : Void ([i : Natural 0]) program-text])])
(when (< i (vector-length (machine-text m))) (let: ([m : machine (make-machine (make-undefined)
(let: ([stmt : Statement (vector-ref (machine-text m) i)]) (make-undefined)
(when (symbol? stmt) '()
(hash-set! (machine-jump-table m) stmt i)) '()
(loop (add1 i))))) 0
m))) (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 ;; 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 0)) 0)
(test (machine-pc (step-n m 1)) 1) (test (machine-pc (step-n m 1)) 1)
(test (machine-pc (step-n m 1)) 2) (test (machine-pc (step-n m 1)) 2)
@ -52,13 +53,15 @@
;; Assigning to val ;; 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)) (test (machine-val m) (make-undefined))
(step! m) (step! m)
(test (machine-val m) 42)) (test (machine-val m) 42))
;; Assigning to proc ;; 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)) (test (machine-proc m) (make-undefined))
(step! m) (step! m)
(test (machine-proc m) 42)) (test (machine-proc m) 42))
@ -66,7 +69,8 @@
;; Assigning to a environment reference ;; Assigning to a environment reference
(let* ([m (new-machine `(,(make-PushEnvironment 1 #f) (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)]) [m (run m)])
(test (machine-env m) '(42))) (test (machine-env m) '(42)))