From eb0eee57bd8801ebfc5dedaee1ab271e66e2fae5 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Mon, 28 Mar 2011 22:36:58 -0400
Subject: [PATCH] fixing some primitives

---
 assemble.rkt      | 26 +++++++++++++++++++++++++-
 il-structs.rkt    |  1 +
 runtime.js        | 37 ++++++++++++++++++++++++-------------
 simulator.rkt     | 12 ++++++++++++
 test-compiler.rkt |  8 ++++++++
 5 files changed, 70 insertions(+), 14 deletions(-)

diff --git a/assemble.rkt b/assemble.rkt
index d72d5e9..9c0a388 100644
--- a/assemble.rkt
+++ b/assemble.rkt
@@ -431,11 +431,28 @@ EOF
         (case operator
           [(+)
            (cond [(empty? rand-vals)
-                  "(0)"]
+                  "0"]
                  [else
                   (string-append "(" 
                                  (string-join rand-vals " + ") 
                                  ")")])]
+          [(-)
+           (cond [(empty? rand-vals)
+                  (error '- "Expects at least 1 argument, given 0")]
+                 [(empty? (rest rand-vals))
+                  (format "(-(~a))" (first rand-vals))]
+                 [else
+                  (string-append "(" (string-join rand-vals "-") ")")])]
+          [(*)
+           (cond [(empty? rand-vals)
+                  "1"]
+                 [else
+                  (string-append "(" (string-join rand-vals "*") ")")])]
+          [(/)
+           (cond [(empty? rand-vals)
+                  (error '/ "Expects at least 1 argument, given 0")]
+                 [else
+                  (string-append "(" (string-join rand-vals "/") ")")])]
           [(add1)
            (unless (= 1 (length rand-vals))
              (error 'add1 "Expected one argument"))
@@ -468,6 +485,13 @@ EOF
            (unless (= (length rand-vals) 1)
              (error 'cdr "Expected one argument"))
            (format "(~a)[1]" (first rand-vals))]
+          [(list)
+           (let loop ([rand-vals rand-vals])
+             (cond
+               [(empty? rand-vals)
+                "Primitives.null"]
+               [else
+                (format "[~a,~a]" (first rand-vals) (loop (rest rand-vals)))]))]
           [(null?)
            (unless (= (length rand-vals) 1)
              (error 'null? "Expected one argument"))
diff --git a/il-structs.rkt b/il-structs.rkt
index e0fd4ad..92b65da 100644
--- a/il-structs.rkt
+++ b/il-structs.rkt
@@ -170,6 +170,7 @@
                                     'cons
                                     'car
                                     'cdr
+                                    'list
                                     'null?
                                     ))
 (define-predicate KernelPrimitiveName? KernelPrimitiveName)
diff --git a/runtime.js b/runtime.js
index f6fd477..77b5a60 100644
--- a/runtime.js
+++ b/runtime.js
@@ -84,28 +84,39 @@ var Primitives = (function() {
 	},
 	
 	'+': function(MACHINE, arity) {
-	    var firstArg = MACHINE.env[MACHINE.env.length-1];
-	    var secondArg = MACHINE.env[MACHINE.env.length-2];
-
-            return firstArg + secondArg;
+	    var result = 0;
+	    while (arity > 0) {
+		result += MACHINE.env[MACHINE.env.length - arity];
+		arity--;
+	    };
+	    return result;
 	},
 	
 	'*': function(MACHINE, arity) {
-	    var firstArg = MACHINE.env[MACHINE.env.length-1];
-	    var secondArg = MACHINE.env[MACHINE.env.length-2];
-            return firstArg * secondArg;
+	    var result = 1;
+	    while (arity > 0) {
+		result *= MACHINE.env[MACHINE.env.length - arity];
+		arity--;
+	    };
 	},
 	
 	'-': function(MACHINE, arity) {
-	    var firstArg = MACHINE.env[MACHINE.env.length-1];
-	    var secondArg = MACHINE.env[MACHINE.env.length-2];
-            return firstArg - secondArg;
+	    if (arity === 0) { throw new Error(); }
+	    if (arity === 1) { return -(MACHINE.env[MACHINE.env.length-1]); }
+	    var result = MACHINE.env[MACHINE.env.length - 1];
+	    for (var i = 1; i < arity; i++) {
+		result -= MACHINE.env[MACHINE.env.length - 1 - i];
+	    }
+	    return result;
 	},
 	
 	'/': function(MACHINE, arity) {
-	    var firstArg = MACHINE.env[MACHINE.env.length-1];
-	    var secondArg = MACHINE.env[MACHINE.env.length-2];
-	    return firstArg / secondArg;
+	    if (arity === 0) { throw new Error(); }
+	    var result = MACHINE.env[MACHINE.env.length - 1];
+	    for (var i = 1; i < arity; i++) {
+		result /= MACHINE.env[MACHINE.env.length - 1 - i];
+	    }
+	    return result;
 	},
 
 	'cons': function(MACHINE, arity) {
diff --git a/simulator.rkt b/simulator.rkt
index 60e0594..e403d19 100644
--- a/simulator.rkt
+++ b/simulator.rkt
@@ -350,6 +350,12 @@
         (case op
           [(+)
            (apply + (map ensure-number rand-vals))]
+          [(-)
+           (apply - (ensure-number (first rand-vals)) (map ensure-number (rest rand-vals)))]
+          [(*)
+           (apply * (map ensure-number rand-vals))]
+          [(/)
+           (apply / (ensure-number (first rand-vals)) (map ensure-number (rest rand-vals)))]
           [(add1)
            (add1 (ensure-number (first rand-vals)))]
           [(sub1)
@@ -366,6 +372,12 @@
            (MutablePair-h (ensure-mutable-pair (first rand-vals)))]
           [(cdr)
            (MutablePair-t (ensure-mutable-pair (first rand-vals)))]
+          [(list)
+           (let: loop : PrimitiveValue ([rand-vals : (Listof PrimitiveValue) rand-vals])
+             (cond [(empty? rand-vals)
+                    null]
+                   [(make-MutablePair (first rand-vals)
+                                      (loop (rest rand-vals)))]))]
           [(null?)
            (null? (first rand-vals))]
           [else
diff --git a/test-compiler.rkt b/test-compiler.rkt
index 9118e28..8b68308 100644
--- a/test-compiler.rkt
+++ b/test-compiler.rkt
@@ -140,6 +140,14 @@
 (test '(/ 10 5)
       2)
 
+(test '(- 1 2)
+      -1)
+
+(test '(- 3)
+      -3)
+
+(test '(*)
+      1)
 
 ;; composition of square
 (test '(begin (define (f x)