diff options
Diffstat (limited to 'sca-cpp/trunk/modules/scheme')
-rw-r--r-- | sca-cpp/trunk/modules/scheme/primitive.hpp | 59 | ||||
-rw-r--r-- | sca-cpp/trunk/modules/scheme/test.scm | 2 |
2 files changed, 56 insertions, 5 deletions
diff --git a/sca-cpp/trunk/modules/scheme/primitive.hpp b/sca-cpp/trunk/modules/scheme/primitive.hpp index 2e0c4f62dd..4815e9a497 100644 --- a/sca-cpp/trunk/modules/scheme/primitive.hpp +++ b/sca-cpp/trunk/modules/scheme/primitive.hpp @@ -26,9 +26,12 @@ * Script evaluator primitive functions. */ +#include <math.h> + #include "stream.hpp" #include "function.hpp" #include "list.hpp" +#include "tree.hpp" #include "value.hpp" #include "parallel.hpp" @@ -90,10 +93,30 @@ inline const value listProc(const list<value>& args) { } inline const value assocProc(const list<value>& args) { - return assoc(car(args), (list<list<value> >)cadr(args)); + return assoc(car(args), (list<value>)cadr(args)); +} + +inline const value delAssocProc(const list<value>& args) { + return delAssoc(car(args), (list<value>)cadr(args)); +} + +inline const value substAssocProc(const list<value>& args) { + return substAssoc(car(args), (list<value>)cadr(args), (list<value>)caddr(args)); +} + +inline const value treeDelAssocProc(const list<value>& args) { + return treeDelAssoc((list<value>)car(args), (list<value>)cadr(args)); +} + +inline const value treeSubstAssocProc(const list<value>& args) { + return treeSubstAssoc((list<value>)car(args), (list<value>)cadr(args), (list<value>)caddr(args)); } -inline const value nulProc(const list<value>& args) { +inline const value treeSelectAssocProc(const list<value>& args) { + return treeSelectAssoc((list<value>)car(args), (list<value>)cadr(args)); +} + +inline const value nullProc(const list<value>& args) { const value v(car(args)); if (isNil(v)) return true; @@ -106,6 +129,14 @@ inline const value equalProc(const list<value>& args) { return (bool)(car(args) == cadr(args)); } +inline const value greaterProc(const list<value>& args) { + return (bool)(car(args) > cadr(args)); +} + +inline const value lesserProc(const list<value>& args) { + return (bool)(car(args) < cadr(args)); +} + inline const value addProc(const list<value>& args) { if (isNil(cdr(args))) return (double)car(args); @@ -126,6 +157,10 @@ inline const value divProc(const list<value>& args) { return (double)car(args) / (double)cadr(args); } +inline const value sqrtProc(const list<value>& args) { + return (double)sqrt((double)car(args)); +} + inline const value displayProc(const list<value>& args) { if (isNil(args)) { displayStream() << endl; @@ -216,14 +251,22 @@ inline const list<value> primitiveProcedureNames() { + "cdr" + "cons" + "list" - + "nul" + + "null?" + "=" + "equal?" + + "<" + + ">" + "+" + "-" + "*" + "/" + + "sqrt" + "assoc" + + "del-assoc" + + "subst-assoc" + + "tree-select-assoc" + + "tree-del-assoc" + + "tree-subst-assoc" + "cadr" + "caddr" + "cadddr" @@ -242,14 +285,22 @@ inline const list<value> primitiveProcedureObjects() { + primitiveProcedure(cdrProc) + primitiveProcedure(consProc) + primitiveProcedure(listProc) - + primitiveProcedure(nulProc) + + primitiveProcedure(nullProc) + primitiveProcedure(equalProc) + primitiveProcedure(equalProc) + + primitiveProcedure(lesserProc) + + primitiveProcedure(greaterProc) + primitiveProcedure(addProc) + primitiveProcedure(subProc) + primitiveProcedure(mulProc) + primitiveProcedure(divProc) + + primitiveProcedure(sqrtProc) + primitiveProcedure(assocProc) + + primitiveProcedure(delAssocProc) + + primitiveProcedure(substAssocProc) + + primitiveProcedure(treeSelectAssocProc) + + primitiveProcedure(treeDelAssocProc) + + primitiveProcedure(treeSubstAssocProc) + primitiveProcedure(cadrProc) + primitiveProcedure(caddrProc) + primitiveProcedure(cadddrProc) diff --git a/sca-cpp/trunk/modules/scheme/test.scm b/sca-cpp/trunk/modules/scheme/test.scm index 4bbff6e5c2..41d6296ba3 100644 --- a/sca-cpp/trunk/modules/scheme/test.scm +++ b/sca-cpp/trunk/modules/scheme/test.scm @@ -22,7 +22,7 @@ ; ATOMPub test case (define (get id) - (if (nul id) + (if (null? id) '((feed (title "Sample Feed") (id "123456789") (entry (((title "Item") (id "111") (content (item (name "Apple") (currencyCode "USD") (currencySymbol "$") (price 2.99)))) ((title "Item") (id "222") (content (item (name "Orange") (currencyCode "USD") (currencySymbol "$") (price 3.55)))) |