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

test-simulator appears to be doing something.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-04 17:08:14 -05:00
parent c84eba7786
commit 27ee4739cc
2 changed files with 37 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
simulator.rkt
View File

@ -139,7 +139,12 @@
(let: ([op : PrimitiveCommand (PerformStatement-op stmt)]) (let: ([op : PrimitiveCommand (PerformStatement-op stmt)])
(cond (cond
[(SetToplevel!? op) [(SetToplevel!? op)
(error 'step-perform)] (env-mutate m
(SetToplevel!-depth op)
(toplevel-mutate (ensure-toplevel (env-ref m (SetToplevel!-depth op)))
(SetToplevel!-pos op)
(machine-val m)))]
[(CheckToplevelBound!? op) [(CheckToplevelBound!? op)
(error 'step-perform)] (error 'step-perform)]
[(ExtendEnvironment/Prefix!? op) [(ExtendEnvironment/Prefix!? op)
@ -182,7 +187,15 @@
[else [else
(error 'ensure-symbol)])) (error 'ensure-symbol)]))
(: ensure-toplevel (Any -> toplevel))
(define (ensure-toplevel v)
(cond
[(toplevel? v)
v]
[else
(error 'ensure-toplevel)]))
(: current-instruction (machine -> Statement)) (: current-instruction (machine -> Statement))
(define (current-instruction m) (define (current-instruction m)
@ -280,3 +293,9 @@
(loop (add1 i))]))) (loop (add1 i))])))
(: toplevel-mutate (toplevel Natural Any -> toplevel))
(define (toplevel-mutate a-top index v)
(make-toplevel (append (take (toplevel-vals a-top) index)
(list v)
(drop (toplevel-vals a-top) (add1 index)))))

23
test-simulator.rkt
View File

@ -230,16 +230,25 @@
(lookup-primitive '-) (lookup-primitive '-)
(lookup-primitive '*) (lookup-primitive '*)
(lookup-primitive '=))))) (lookup-primitive '=)))))
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable))) (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable)))
,(make-AssignImmediateStatement 'val (make-Const "Danny")) ,(make-AssignImmediateStatement 'val (make-Const "Danny"))
,(make-PerformStatement (make-SetToplevel! 0 0 'some-variable))))]) ,(make-PerformStatement (make-SetToplevel! 0 0 'some-variable))))])
(run m) (run m)
;; FIXME: I'm hitting what appears to be a Typed Racket bug that prevents me from inspecting ;; FIXME: I'm hitting what appears to be a Typed Racket bug that prevents me from inspecting
;; the toplevel structure in the environment... :( ;; the toplevel structure in the environment... :(
#;(test (first (machine-env (run m))) )
(make-toplevel (vector (lookup-primitive '+) (let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable another)))
(lookup-primitive '-) ,(make-AssignImmediateStatement 'val (make-Const "Danny"))
(lookup-primitive '*) ,(make-PerformStatement (make-SetToplevel! 0 1 'another))))])
(lookup-primitive '=))))) (run m)
;; FIXME: I'm hitting what appears to be a Typed Racket bug that prevents me from inspecting
;; the toplevel structure in the environment... :(
)
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(some-variable)))
,(make-AssignImmediateStatement 'val (make-Const "Danny"))
,(make-PushEnvironment 5)
,(make-PerformStatement (make-SetToplevel! 5 0 'some-variable))))])
(run m)
;; FIXME: I'm hitting what appears to be a Typed Racket bug that prevents me from inspecting
;; the toplevel structure in the environment... :(
)