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

primitive application

Browse Source
This commit is contained in:
Danny Yoo 2011-03-07 17:49:07 -05:00
parent c08c6ed667
commit 4924f92528
2 changed files with 23 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
simulator.rkt
View File

@ -207,7 +207,15 @@
(MakeCompiledProcedure-closed-vals op))))]
[(ApplyPrimitiveProcedure? op)
m]
(let: ([prim : SlotValue (machine-proc m)]
[args : (Listof PrimitiveValue)
(map ensure-primitive-value (take (machine-env m)
(ApplyPrimitiveProcedure-arity op)))])
(cond
[(primitive-proc? prim)
(target-updater m (ensure-primitive-value (apply (primitive-proc-f prim) args)))]
[else
(error 'apply-primitive-procedure)]))]
[(LookupLexicalAddress? op)
(let: ([a-val : SlotValue (env-ref m (LookupLexicalAddress-depth op))])

14
test-simulator.rkt
View File

@ -400,6 +400,20 @@
(test (machine-val (run m))
'curly))
;; ApplyPrimitiveProcedure
;; Adding two numbers
(let ([m (new-machine `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
,(make-AssignPrimOpStatement 'proc (make-LookupToplevelAddress 0 0 '+))
,(make-PushEnvironment 2)
,(make-AssignImmediateStatement (make-EnvLexicalReference 0) (make-Const 126389))
,(make-AssignImmediateStatement (make-EnvLexicalReference 1) (make-Const 42))
,(make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure 2))))])
(test (machine-val (run m))
(+ 126389 42))
(test (machine-env (run m))
(list 126389 42 (make-toplevel (list (lookup-primitive '+))))))
#;(let ([m (new-machine `(,(make-AssignPrimOpStatement (make-LookupLexicalAddress))))])