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

fixing up application

Browse Source
This commit is contained in:
Danny Yoo 2011-07-28 17:28:14 -04:00
parent 7e3baee864
commit ba2544653b
5 changed files with 63 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
js-assembler/assemble-helpers.rkt
View File

@ -67,26 +67,36 @@
(: assemble-target (Target -> String))
(: assemble-target (Target -> (String -> String)))
(define (assemble-target target)
(cond
[(eq? target 'proc)
"MACHINE.proc"]
[(eq? target 'val)
"MACHINE.val"]
[(eq? target 'argcount)
"MACHINE.argcount"]
[(EnvLexicalReference? target)
(assemble-lexical-reference target)]
[(EnvPrefixReference? target)
(assemble-prefix-reference target)]
[(PrimitivesReference? target)
(format "RUNTIME.Primitives[~s]" (symbol->string (PrimitivesReference-name target)))]
[(ControlFrameTemporary? target)
(assemble-control-frame-temporary target)]
[(ModulePrefixTarget? target)
(format "MACHINE.modules[~s].prefix"
(symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))]))
[(PrimitivesReference? target)
(lambda: ([rhs : String])
(format "RUNTIME.Primitives[~s] = RUNTIME.Primitives[~s] || ~a;"
(symbol->string (PrimitivesReference-name target))
(symbol->string (PrimitivesReference-name target))
rhs))]
[else
(lambda: ([rhs : String])
(format "~a = ~a;"
(cond
[(eq? target 'proc)
"MACHINE.proc"]
[(eq? target 'val)
"MACHINE.val"]
[(eq? target 'argcount)
"MACHINE.argcount"]
[(EnvLexicalReference? target)
(assemble-lexical-reference target)]
[(EnvPrefixReference? target)
(assemble-prefix-reference target)]
[(ControlFrameTemporary? target)
(assemble-control-frame-temporary target)]
[(ModulePrefixTarget? target)
(format "MACHINE.modules[~s].prefix"
(symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])
rhs))]))
(: assemble-control-frame-temporary (ControlFrameTemporary -> String))

9
js-assembler/assemble.rkt
View File

@ -138,14 +138,13 @@ EOF
[(DebugPrint? stmt)
(format "MACHINE.params.currentOutputPort.writeDomNode(MACHINE, $('<span/>').text(~a));" (assemble-oparg (DebugPrint-value stmt)))]
[(AssignImmediateStatement? stmt)
(let: ([t : String (assemble-target (AssignImmediateStatement-target stmt))]
(let: ([t : (String -> String) (assemble-target (AssignImmediateStatement-target stmt))]
[v : OpArg (AssignImmediateStatement-value stmt)])
(format "~a = ~a;" t (assemble-oparg v)))]
(t (assemble-oparg v)))]
[(AssignPrimOpStatement? stmt)
(format "~a=~a;"
(assemble-target (AssignPrimOpStatement-target stmt))
(assemble-op-expression (AssignPrimOpStatement-op stmt)))]
((assemble-target (AssignPrimOpStatement-target stmt))
(assemble-op-expression (AssignPrimOpStatement-op stmt)))]
[(PerformStatement? stmt)
(assemble-op-statement (PerformStatement-op stmt))]

28
tests/more-tests/simple-apply.expected
View File

@ -1,5 +1,31 @@
14
'(2 3 4 5)
14
14
14
14
120
120
120
120
120
(2 3 4 5)
(2 3 4 5)
(2 3 4 5)
(2 3 4 5)
(2 3 4 5)
14
15
#f
(3 4 5)
49
"squaring"
49
64
"now factorial"
1
1
2
6
24
120
144

6
tests/more-tests/simple-apply.rkt
View File

@ -52,9 +52,9 @@
(apply * `(,x ,(apply f (apply sub1 (apply list x '())) '())))]))
(f 0)
(f 1)
(apply f 1 '())
(f 2)
(f 3)
(apply f '(3))
(f 4)
(f 5)
(+ (f 4) (f 5))
(+ (apply f 4 '()) (f 5))

2
tests/run-more-tests.rkt
View File

@ -17,4 +17,4 @@
(test "more-tests/lists.rkt")
(test "more-tests/earley.rkt")
(test "more-tests/hello-bf.rkt")
#;(test "more-tests/simple-apply.rkt")
(test "more-tests/simple-apply.rkt")