fixing up application

js-assembler/assemble-helpers.rkt

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

js-assembler/assemble.rkt

@@ -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-target (AssignPrimOpStatement-target stmt))
+       (assemble-op-expression (AssignPrimOpStatement-op stmt)))]
-              (assemble-op-expression (AssignPrimOpStatement-op stmt)))]
      
      [(PerformStatement? stmt)
       (assemble-op-statement (PerformStatement-op stmt))]

tests/more-tests/simple-apply.expected

@@ -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

tests/more-tests/simple-apply.rkt

@@ -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))

tests/run-more-tests.rkt

@@ -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")