added support for `cons`, `car`, `cdr`

author: Teddy <ted.sybil@gmail.com> 2013-08-04 23:35:59 +0800
committer: Teddy <ted.sybil@gmail.com> 2013-08-04 23:35:59 +0800
commit: 645549b8a42844fc5a8042a4808c8ebf5050d7da (patch)
tree: 6f96ef92e16f332a6eb3860450404903865a12fe /builtin.cpp
parent: acb298c7f864f9862859320555b416c97632d2fa (diff)
1 files changed, 67 insertions, 36 deletions
diff --git a/builtin.cpp b/builtin.cpp
index 374f3f2..f1b518f 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -47,50 +47,50 @@ SpecialOptIf::SpecialOptIf() : SpecialOptObj() {}
 void SpecialOptIf::prepare(Cons *pc) {
     state = 0;  // Prepared
 
-    pc = pc->cdr;
+    pc = TO_CONS(pc->cdr);
     if (pc == empty_list)
         throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP);
     pc->skip = false;
 
-    pc = pc->cdr;
+    pc = TO_CONS(pc->cdr);
     if (pc == empty_list)
         throw TokenError("if", SYN_ERR_MISS_OR_EXTRA_EXP);
 
     pc->skip = true;
     if (pc->cdr != empty_list)
-        pc->cdr->skip = true;
+        TO_CONS(pc->cdr)->skip = true;
 }
 
 void SpecialOptIf::pre_call(ArgList *args, Cons *pc,
         Environment *envt) {
     // static_cast because it's a call invocation
-    pc = static_cast<Cons*>(pc->car)->cdr; 
+    pc = TO_CONS(TO_CONS(pc->car)->cdr); 
 
     // Condition evaluated and the decision is made
     state = 1;
 
-    if (args->cdr->car->is_true())
+    if (TO_CONS(args->cdr)->car->is_true())
     {
         pc->skip = true;
-        pc = pc->cdr;
+        pc = TO_CONS(pc->cdr);
         pc->skip = false;
         if (pc->cdr != empty_list)
-            pc->cdr->skip = true; // Eval the former
+            TO_CONS(pc->cdr)->skip = true; // Eval the former
     }
     else
     {
         pc->skip = true;
-        pc = pc->cdr;
-        pc->cdr->skip = true;
+        pc = TO_CONS(pc->cdr);
+        TO_CONS(pc->cdr)->skip = true;
         if (pc->cdr != empty_list)
-            pc->cdr->skip = false; //Eval the latter
+            TO_CONS(pc->cdr)->skip = false; //Eval the latter
     }
 }
 
 EvalObj *SpecialOptIf::post_call(ArgList *args, Cons *pc,
                                 Environment *envt) {
     // Value already evaluated, so just return it
-    return args->cdr->car;
+    return TO_CONS(args->cdr)->car;
 }
 
 Cons *SpecialOptIf::call(ArgList *args, Environment * &envt, 
@@ -119,7 +119,8 @@ string SpecialOptIf::_debug_repr() { return ext_repr(); }
 
 SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {}
 #define FILL_MARKS(pc, flag) \
-    for (Cons *ptr = pc->cdr; ptr != empty_list; ptr = ptr->cdr) \
+    for (Cons *ptr = TO_CONS(pc->cdr); \
+            ptr != empty_list; ptr = TO_CONS(ptr->cdr)) \
         ptr->skip = flag
 
 void SpecialOptLambda::prepare(Cons *pc) {
@@ -136,16 +137,16 @@ Cons *SpecialOptLambda::call(ArgList *args, Environment * &envt,
 
     if (pc->cdr == empty_list)
         throw TokenError("lambda", SYN_ERR_EMPTY_PARA_LIST);
-    if (pc->cdr->cdr == empty_list)
+    if (TO_CONS(pc->cdr)->cdr == empty_list)
         throw TokenError("lambda", SYN_ERR_MISS_OR_EXTRA_EXP);
 
-    SymbolList *para_list = static_cast<SymbolList*>(pc->cdr->car); 
+    SymbolList *para_list = static_cast<SymbolList*>(TO_CONS(pc->cdr)->car); 
     // Clear the flag to avoid side-effects (e.g. proc calling)
     FILL_MARKS(pc, false);
 
     // store a list of expressions inside <body>
-    ASTList *body = pc->cdr->cdr;       // Truncate the expression list
-    for (Cons *ptr = body; ptr != empty_list; ptr = ptr->cdr)
+    ASTList *body = TO_CONS(TO_CONS(pc->cdr)->cdr);       // Truncate the expression list
+    for (Cons *ptr = body; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
         ptr->next = NULL;    // Make each expression an orphan
 
     *top_ptr++ = new ProcObj(body, envt, para_list);
@@ -164,13 +165,13 @@ void SpecialOptDefine::prepare(Cons *pc) {
     if (pc->cdr == empty_list)
         throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP);
 
-    if (pc->cdr->car->is_simple_obj())  // Simple value assignment
+    if (TO_CONS(pc->cdr)->car->is_simple_obj())  // Simple value assignment
     {
-        pc = pc->cdr;
+        pc = TO_CONS(pc->cdr);
         if (pc->cdr == empty_list)
             throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP);
         pc->skip = true;           // Skip the identifier
-        pc->cdr->skip = false; 
+        TO_CONS(pc->cdr)->skip = false; 
     }                                   // Procedure definition
     else FILL_MARKS(pc, true);          // Skip all parts
 }
@@ -182,19 +183,19 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt,
     EvalObj *obj;
     SymObj *id;
     // TODO: check identifier
-    EvalObj *first = pc->cdr->car;
+    EvalObj *first = TO_CONS(pc->cdr)->car;
     if (first->is_simple_obj())
     {
         if (!first->is_sym_obj())
             throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
 
         id = static_cast<SymObj*>(first);
-        obj = args->cdr->car;
+        obj = TO_CONS(args->cdr)->car;
     }
     else
     {
         // static_cast because of is_simple_obj() is false
-        Cons *plst = static_cast<Cons*>(pc->cdr->car);
+        Cons *plst = static_cast<Cons*>(TO_CONS(pc->cdr)->car);
 
         if (plst == empty_list)
             throw TokenError("if", SYN_ERR_EMPTY_PARA_LIST);
@@ -202,16 +203,16 @@ Cons *SpecialOptDefine::call(ArgList *args, Environment * &envt,
             throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
 
         id = static_cast<SymObj*>(plst->car);
-        ArgList *para_list = plst->cdr;
+        ArgList *para_list = TO_CONS(plst->cdr);
         // Clear the flag to avoid side-effects (e.g. proc calling)
         FILL_MARKS(pc, false);
 
-        ASTList *body = pc->cdr->cdr;   // Truncate the expression list
+        ASTList *body = TO_CONS(TO_CONS(pc->cdr)->cdr);   // Truncate the expression list
 
         if (body == empty_list)
             throw TokenError("define", SYN_ERR_MISS_OR_EXTRA_EXP);
 
-        for (Cons *ptr = body; ptr != empty_list; ptr = ptr->cdr)
+        for (Cons *ptr = body; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
             ptr->next = NULL;           // Make each expression a orphan
 
         obj = new ProcObj(body, envt, para_list);
@@ -228,13 +229,13 @@ string SpecialOptDefine::_debug_repr() { return ext_repr(); }
 #endif
 
 void SpecialOptSet::prepare(Cons *pc) {
-    pc = pc->cdr;
+    pc = TO_CONS(pc->cdr);
     if (pc == empty_list)
         throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP);
 
     pc->skip = true;       // Skip the identifier
 
-    pc = pc->cdr;
+    pc = TO_CONS(pc->cdr);
     if (pc == empty_list)
         throw TokenError("set!", SYN_ERR_MISS_OR_EXTRA_EXP);
 
@@ -245,14 +246,14 @@ Cons *SpecialOptSet::call(ArgList *args, Environment * &envt,
                             Continuation * &cont, FrameObj ** &top_ptr) {
     Cons *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
     Cons *pc = static_cast<Cons*>(ret_addr->car);
-    EvalObj *first = pc->cdr->car;
+    EvalObj *first = TO_CONS(pc->cdr)->car;
 
     if (!first->is_sym_obj())
         throw TokenError(first->ext_repr(), SYN_ERR_NOT_AN_ID);
 
     SymObj *id = static_cast<SymObj*>(first);
 
-    bool flag = envt->add_binding(id, args->cdr->car, false);
+    bool flag = envt->add_binding(id, TO_CONS(args->cdr)->car, false);
     if (!flag) throw TokenError(id->ext_repr(), RUN_ERR_UNBOUND_VAR);
     *top_ptr++ = new UnspecObj();
     return ret_addr->next;
@@ -266,10 +267,39 @@ string SpecialOptSet::ext_repr() { return string("#<Builtin Macro: set!>"); }
 string SpecialOptSet::_debug_repr() { return ext_repr(); }
 #endif
 
+EvalObj *builtin_cons(ArgList *args) {
+    if (args == empty_list ||
+        args->cdr == empty_list ||
+        TO_CONS(args->cdr)->cdr != empty_list)
+        throw TokenError("cons", RUN_ERR_WRONG_NUM_OF_ARGS);
+
+    return new Cons(args->car, TO_CONS(args->cdr)->car);
+}
+
+EvalObj *builtin_car(ArgList *args) {
+    if (args == empty_list ||
+        args->cdr != empty_list)
+        throw TokenError("car", RUN_ERR_WRONG_NUM_OF_ARGS);
+    if (!args->car->is_cons_obj())
+        throw TokenError("pair", RUN_ERR_WRONG_TYPE);
+
+    return TO_CONS(args->car)->car;
+}
+
+EvalObj *builtin_cdr(ArgList *args) {
+    if (args == empty_list ||
+        args->cdr != empty_list)
+        throw TokenError("cdr", RUN_ERR_WRONG_NUM_OF_ARGS);
+    if (!args->car->is_cons_obj())
+        throw TokenError("pair", RUN_ERR_WRONG_TYPE);
+
+    return TO_CONS(args->car)->cdr;
+}
+
 EvalObj *builtin_plus(ArgList *args) {
     // TODO: type conversion and proper arithmetic
     int res = 0;
-    for (Cons *ptr = args; ptr != empty_list; ptr = ptr->cdr)
+    for (Cons *ptr = args; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
         res += dynamic_cast<IntObj*>(ptr->car)->val;
     return new IntObj(res);
 }
@@ -277,7 +307,8 @@ EvalObj *builtin_plus(ArgList *args) {
 EvalObj *builtin_minus(ArgList *args) {
     // TODO: type conversion and proper arithmetic
     int res = dynamic_cast<IntObj*>(args->car)->val;
-    for (Cons *ptr = args->cdr; ptr != empty_list; ptr = ptr->cdr)
+    for (Cons *ptr = TO_CONS(args->cdr); 
+            ptr != empty_list; ptr = TO_CONS(ptr->cdr))
         res -= dynamic_cast<IntObj*>(ptr->car)->val;
     return new IntObj(res);
 }
@@ -285,7 +316,7 @@ EvalObj *builtin_minus(ArgList *args) {
 EvalObj *builtin_times(ArgList *args) {
     // TODO: type conversion and proper arithmetic
     int res = 1;
-    for (Cons *ptr = args; ptr != empty_list; ptr = ptr->cdr)
+    for (Cons *ptr = args; ptr != empty_list; ptr = TO_CONS(ptr->cdr))
         res *= dynamic_cast<IntObj*>(ptr->car)->val;
     return new IntObj(res);
 }
@@ -293,24 +324,24 @@ EvalObj *builtin_times(ArgList *args) {
 EvalObj *builtin_div(ArgList *args) {
     // TODO: type conversion and proper arithmetic
     int res = dynamic_cast<IntObj*>(args->car)->val;
-    for (Cons *ptr = args->cdr; ptr != empty_list; ptr = ptr->cdr)
+    for (Cons *ptr = TO_CONS(args->cdr); ptr != empty_list; ptr = TO_CONS(ptr->cdr))
         res /= dynamic_cast<IntObj*>(ptr->car)->val;
     return new IntObj(res);
 }
 
 EvalObj *builtin_lt(ArgList *args) {
     return new BoolObj(dynamic_cast<IntObj*>(args->car)->val <
-                    dynamic_cast<IntObj*>(args->cdr->car)->val);
+                    dynamic_cast<IntObj*>(TO_CONS(args->cdr)->car)->val);
 }
 
 EvalObj *builtin_gt(ArgList *args) {
     return new BoolObj(dynamic_cast<IntObj*>(args->car)->val >
-                    dynamic_cast<IntObj*>(args->cdr->car)->val);
+                    dynamic_cast<IntObj*>(TO_CONS(args->cdr)->car)->val);
 }
 
 EvalObj *builtin_arithmetic_eq(ArgList *args) {
     return new BoolObj(dynamic_cast<IntObj*>(args->car)->val ==
-                    dynamic_cast<IntObj*>(args->cdr->car)->val);
+                    dynamic_cast<IntObj*>(TO_CONS(args->cdr)->car)->val);
 }
 
 EvalObj *builtin_display(ArgList *args) {
author	Teddy <ted.sybil@gmail.com>	2013-08-04 23:35:59 +0800
committer	Teddy <ted.sybil@gmail.com>	2013-08-04 23:35:59 +0800
commit	645549b8a42844fc5a8042a4808c8ebf5050d7da (patch)
tree	6f96ef92e16f332a6eb3860450404903865a12fe /builtin.cpp
parent	acb298c7f864f9862859320555b416c97632d2fa (diff)