From ba2544653b8f66e646d1d72581160fbbdea0f481 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Thu, 28 Jul 2011 17:28:14 -0400
Subject: [PATCH] fixing up application

---
 js-assembler/assemble-helpers.rkt      | 46 ++++++++++++++++----------
 js-assembler/assemble.rkt              |  9 +++--
 tests/more-tests/simple-apply.expected | 28 +++++++++++++++-
 tests/more-tests/simple-apply.rkt      |  6 ++--
 tests/run-more-tests.rkt               |  2 +-
 5 files changed, 63 insertions(+), 28 deletions(-)

diff --git a/js-assembler/assemble-helpers.rkt b/js-assembler/assemble-helpers.rkt
index 45ed58c..51e0d3e 100644
--- a/js-assembler/assemble-helpers.rkt
+++ b/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)
-     "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))
diff --git a/js-assembler/assemble.rkt b/js-assembler/assemble.rkt
index da69908..8f57333 100644
--- a/js-assembler/assemble.rkt
+++ b/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-op-expression (AssignPrimOpStatement-op stmt)))]
+      ((assemble-target (AssignPrimOpStatement-target stmt))
+       (assemble-op-expression (AssignPrimOpStatement-op stmt)))]
      
      [(PerformStatement? stmt)
       (assemble-op-statement (PerformStatement-op stmt))]
diff --git a/tests/more-tests/simple-apply.expected b/tests/more-tests/simple-apply.expected
index 0672173..a68fda1 100644
--- a/tests/more-tests/simple-apply.expected
+++ b/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
diff --git a/tests/more-tests/simple-apply.rkt b/tests/more-tests/simple-apply.rkt
index 5bba831..361bc8a 100644
--- a/tests/more-tests/simple-apply.rkt
+++ b/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))
\ No newline at end of file
+(+ (apply f 4 '()) (f 5))
diff --git a/tests/run-more-tests.rkt b/tests/run-more-tests.rkt
index d5751a3..bdab7ad 100644
--- a/tests/run-more-tests.rkt
+++ b/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")