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

a few more open-coded primitives

Browse Source
This commit is contained in:
Danny Yoo 2011-03-28 23:23:08 -04:00
parent eb0eee57bd
commit bbb80800db
3 changed files with 29 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
assemble.rkt
View File

@ -473,6 +473,14 @@ EOF
(unless (> (length rand-vals) 0)
(error '= "Expected at least one argument"))
(assemble-chain "==" rand-vals)]
[(>)
(unless (> (length rand-vals) 0)
(error '> "Expected at least one argument"))
(assemble-chain ">" rand-vals)]
[(>=)
(unless (> (length rand-vals) 0)
(error '>= "Expected at least one argument"))
(assemble-chain ">=" rand-vals)]
[(cons)
(unless (= (length rand-vals) 2)
(error 'cons "Expected two arguments"))
@ -496,7 +504,15 @@ EOF
(unless (= (length rand-vals) 1)
(error 'null? "Expected one argument"))
(format "(~a === Primitives.null)"
(first rand-vals))])))
(first rand-vals))]
[(not)
(unless (= (length rand-vals) 1)
(error 'not? "Expected one argument"))
(format "(!~a)" (first rand-vals))]
[(eq?)
(unless (= (length rand-vals) 2)
(error 'eq? "Expected 2 arguments"))
(format "(~a === ~a)" (first rand-vals) (second rand-vals))])))
(: assemble-chain (String (Listof String) -> String))

4
il-structs.rkt
View File

@ -167,11 +167,15 @@
'<
'<=
'=
'>
'>=
'cons
'car
'cdr
'list
'null?
'not
'eq?
))
(define-predicate KernelPrimitiveName? KernelPrimitiveName)

8
simulator.rkt
View File

@ -366,6 +366,10 @@
(chain-compare <= (map ensure-real-number rand-vals))]
[(=)
(chain-compare = (map ensure-real-number rand-vals))]
[(>)
(chain-compare > (map ensure-real-number rand-vals))]
[(>=)
(chain-compare >= (map ensure-real-number rand-vals))]
[(cons)
(make-MutablePair (first rand-vals) (ensure-list (second rand-vals)))]
[(car)
@ -380,6 +384,10 @@
(loop (rest rand-vals)))]))]
[(null?)
(null? (first rand-vals))]
[(not)
(not (first rand-vals))]
[(eq?)
(eq? (first rand-vals) (second rand-vals))]
[else
(error 'evaluate-kernel-primitive-procedure-call "missing operator: ~s\n" op)])))