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

fixing some primitives

Browse Source
This commit is contained in:
Danny Yoo 2011-03-28 22:36:58 -04:00
parent 2cb966f01f
commit eb0eee57bd
5 changed files with 70 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
assemble.rkt
View File

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

1
il-structs.rkt
View File

@ -170,6 +170,7 @@
'cons
'car
'cdr
'list
'null?
))
(define-predicate KernelPrimitiveName? KernelPrimitiveName)

37
runtime.js
View File

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

12
simulator.rkt
View File

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

8
test-compiler.rkt
View File

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