From af2da07be7d3f8a936640ef92b0692710a22e0d4 Mon Sep 17 00:00:00 2001
From: Teddy <ted.sybil@gmail.com>
Date: Fri, 2 Aug 2013 20:51:05 +0800
Subject: transfering the implementation language to C++

---
 builtin.cpp         | 182 ++++++++++++++++++++++++++++++++++++++++++
 builtin.h           | 129 ++++++++++++++++++++++++++++++
 model.cpp           | 121 ++++++++++++++++++++++++++++
 model.h             | 226 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 prototype/sketch.py |   4 +-
 5 files changed, 660 insertions(+), 2 deletions(-)
 create mode 100644 builtin.cpp
 create mode 100644 builtin.h
 create mode 100644 model.cpp
 create mode 100644 model.h
 mode change 100644 => 100755 prototype/sketch.py

diff --git a/builtin.cpp b/builtin.cpp
new file mode 100644
index 0000000..232f873
--- /dev/null
+++ b/builtin.cpp
@@ -0,0 +1,182 @@
+#include "builtin.h"
+#include <sstream>
+
+using std::stringstream;
+
+extern EmptyList *empty_list;
+
+BoolObj::BoolObj(bool _val) : EvalObj(), val(_val) {}
+bool BoolObj::is_true() { return val; }
+string BoolObj::ext_repr() { return string(val ? "#t" : "#f"); }
+#ifdef DEBUG
+string BoolObj::_debug_repr() { return ext_repr(); }
+#endif
+
+IntObj::IntObj(int _val) : NumberObj(), val(_val) {}
+string IntObj::ext_repr() {
+    stringstream ss;
+    ss << val;
+    return ss.str();
+}
+#ifdef DEBUG
+string IntObj::_debug_repr() { return ext_repr(); }
+#endif
+
+FloatObj::FloatObj(double _val) : NumberObj(), val(_val) {}
+string FloatObj::ext_repr() { 
+    stringstream ss;
+    ss << val;
+    return ss.str();
+}
+#ifdef DEBUG
+string FloatObj::_debug_repr() { return ext_repr(); }
+#endif
+
+SpecialOptIf::SpecialOptIf() : SpecialOptObj() {}
+void SpecialOptIf::prepare(Cons *pc) {
+    state = 0;  // Prepared
+    pc = pc->cdr;
+    pc->skip = false;
+    pc->cdr->skip = true;
+    if (pc->cdr->cdr != empty_list)
+        pc->cdr->cdr->skip = true;
+}
+
+void SpecialOptIf::pre_call(ArgList *arg_list, Cons *pc,
+        Environment *envt) {
+    pc = dynamic_cast<Cons*>(pc->car); 
+    // Condition evaluated and the decision is made
+    state = 1;
+    if (arg_list->cdr->car->is_true())
+    {
+        pc = pc->cdr;
+        pc->skip = true;
+        pc->cdr->skip = false;
+        if (pc->cdr->cdr != empty_list)
+            pc->cdr->cdr->skip = true; // Eval the former
+    }
+    else
+    {
+        pc = pc->cdr;
+        pc->skip = true;
+        pc->cdr->skip = true;
+        if (pc->cdr->cdr != empty_list)
+            pc->cdr->cdr->skip = false; //Eval the latter
+    }
+}
+
+EvalObj *SpecialOptIf::post_call(ArgList *arg_list, Cons *pc,
+                                Environment *envt) {
+    // Value already evaluated, so just return it
+    return arg_list->cdr->car;
+}
+Cons *SpecialOptIf::call(ArgList *arg_list, Environment * &envt, 
+                        Continuation * &cont, FrameObj ** &top_ptr) {
+    Cons *ret_addr = dynamic_cast<Cons*>(*top_ptr);
+    if (state) 
+    {
+        *top_ptr = post_call(arg_list, ret_addr, envt);
+        return ret_addr->next;          // Move to the next instruction
+    }
+    else
+    {
+        pre_call(arg_list, ret_addr, envt);
+        top_ptr++;
+        // Undo pop and invoke again
+        return dynamic_cast<Cons*>(ret_addr->car)->next;
+    }
+}
+
+string SpecialOptIf::ext_repr() { return string("#<Builtin Macro: if>"); }
+#ifdef DEBUG
+SpecialOptIf::_debug_repr() { return ext_repr(); }
+#endif
+
+SpecialOptLambda::SpecialOptLambda() : SpecialOptObj() {}
+#define FILL_MARKS(pc, flag) \
+    for (pc = pc->cdr; pc != empty_list; pc = pc->cdr) \
+        pc->skip = flag
+
+void SpecialOptLambda::prepare(Cons *pc) {
+    //TODO check number of arguments
+    // Do not evaluate anything
+    FILL_MARKS(pc, true);
+}
+
+Cons *SpecialOptLambda::call(ArgList *arg_list, Environment * &envt, 
+                            Continuation * &cont, FrameObj ** &top_ptr) {
+    Cons *ret_addr = dynamic_cast<Cons*>(*top_ptr);
+    Cons *pc = dynamic_cast<Cons*>(ret_addr->car);
+    SymbolList *para_list = dynamic_cast<SymbolList*>(pc->cdr->car);  // parameter list
+    // 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)
+        ptr->next = NULL;    // Make each expression a orphan
+
+    *top_ptr = new ProcObj(body, envt, para_list);
+    return ret_addr->next;  // Move to the next instruction
+}
+
+string SpecialOptLambda::ext_repr() { return string("#<Builtin Macro: lambda>"); }
+#ifdef DEBUG
+string SpecialOptLambda::_debug_repr() { return ext_repr(); }
+#endif
+
+SpecialOptDefine::SpecialOptDefine() : SpecialOptObj() {}
+void SpecialOptDefine::prepare(Cons *pc) {
+    if (pc->cdr->car->is_simple_obj())  // Simple value assignment
+    {
+        pc->cdr->skip = true;           // Skip the identifier
+        pc->cdr->cdr->skip = false; 
+    }                                   // Procedure definition
+    else FILL_MARKS(pc, true);          // Skip all parts
+}
+Cons *SpecialOptDefine::call(ArgList *arg_list, Environment * &envt, 
+        Continuation * &cont, FrameObj ** &top_ptr) {
+    Cons *ret_addr = dynamic_cast<Cons*>(*top_ptr);
+    Cons *pc = dynamic_cast<Cons*>(ret_addr->car);
+    EvalObj *obj;
+    SymObj *id;
+    // TODO: check identifier
+    if (pc->cdr->car->is_simple_obj())
+    {
+        id = dynamic_cast<SymObj*>(pc->cdr->car);
+        obj = arg_list->cdr->car;
+    }
+    else
+    {
+        Cons *plst = dynamic_cast<Cons*>(pc->cdr->car);
+        id = dynamic_cast<SymObj*>(plst->car);
+        ArgList *para_list = 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
+        for (Cons *ptr = body; ptr != empty_list; ptr = ptr->cdr)
+            ptr->next = NULL;           // Make each expression a orphan
+
+        obj = new ProcObj(body, envt, para_list);
+    }
+    envt->add_binding(id, obj);
+    *top_ptr = obj;
+    return ret_addr->next;
+}
+
+void SpecialOptSet::prepare(Cons *pc) {
+    // TODO: check number of arguments
+    pc->cdr->skip = true;       // Skip the identifier
+    pc->cdr->cdr->skip = false; 
+}
+
+Cons *SpecialOptSet::call(ArgList *arg_list, Environment * &envt, 
+                            Continuation * &cont, FrameObj ** &top_ptr) {
+    Cons *ret_addr = dynamic_cast<Cons*>(*top_ptr);
+    Cons *pc = dynamic_cast<Cons*>(ret_addr->car);
+    SymObj *id = dynamic_cast<SymObj*>(pc->cdr->car);
+    if (envt->has_obj(id))
+        envt->add_binding(id, arg_list->cdr->car);
+    *top_ptr = new UnspecObj();
+    return ret_addr->next;
+}
diff --git a/builtin.h b/builtin.h
new file mode 100644
index 0000000..a4468ae
--- /dev/null
+++ b/builtin.h
@@ -0,0 +1,129 @@
+#ifndef BUILTIN_H
+#define BUILTIN_H
+
+#include "model.h"
+#include <string>
+
+using std::string;
+
+/** @class BoolObj
+ * Booleans
+ */
+class BoolObj: public EvalObj {
+    private:
+        bool val;                       /**< true for #t, false for #f */ 
+    public:
+        BoolObj(bool); 
+        bool is_true();                 /**< Override EvalObj `is_true()` */
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class IntObj
+ * A simple implementation of integers
+ * Will be removed in the future
+ */
+class IntObj: public NumberObj {
+    private:
+        int val;
+    public:
+        IntObj(int);
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class FloatObj
+ * Floating point numbers
+ */
+class FloatObj: public NumberObj {
+    private:
+        double val;
+    public:
+        FloatObj(double);
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+
+/** @class SpecialOptIf
+ * The implementation of `if` operator
+ */
+class SpecialOptIf: public SpecialOptObj {
+    private:
+        unsigned char state; /**< 0 for prepared, 1 for pre_called */
+        /** 
+         * The evaluator will call this after the <condition> exp is evaluated.
+         * And this function tells the evaluator which of <consequence> and
+         * <alternative> should be evaluted. */
+        void pre_call(ArgList *arg_list, Cons *pc, 
+                Environment *envt);
+        /** The system will call this again after the desired result is
+         * evaluated, so just return it to let the evaluator know the it's the
+         * answer.
+         */
+        EvalObj *post_call(ArgList *arg_list, Cons *pc, 
+                Environment *envt);
+    public:
+        SpecialOptIf();
+        void prepare(Cons *pc);
+        Cons *call(ArgList *arg_list, Environment * &envt, 
+                    Continuation * &cont, FrameObj ** &top_ptr);
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class SpecialOptLambda
+ * The implementation of `lambda` operator
+ */
+class SpecialOptLambda: public SpecialOptObj {
+    public:
+        SpecialOptLambda();
+        void prepare(Cons *pc);
+        Cons *call(ArgList *arg_list, Environment * &envt, 
+                    Continuation * &cont, FrameObj ** &top_ptr);
+
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class SpecialOptDefine
+ * The implementation of `define` operator
+ */
+class SpecialOptDefine: public SpecialOptObj {
+    public:
+        SpecialOptDefine(); 
+        void prepare(Cons *pc);
+        Cons *call(ArgList *arg_list, Environment * &envt, 
+                    Continuation * &cont, FrameObj ** &top_ptr);
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class SpecialOptSet
+ * The implementation of `set!` operator
+ */
+class SpecialOptSet: public SpecialOptObj {
+    public:
+        SpecialOptSet();
+        void prepare(Cons *pc);
+        Cons *call(ArgList *arg_list, Environment * &envt, 
+                    Continuation * &cont, FrameObj ** &top_ptr);
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+#endif
diff --git a/model.cpp b/model.cpp
new file mode 100644
index 0000000..11c7a63
--- /dev/null
+++ b/model.cpp
@@ -0,0 +1,121 @@
+#include "model.h"
+
+EmptyList *empty_list = new EmptyList();
+
+EmptyList::EmptyList() : Cons(NULL, NULL) {}
+string EmptyList::ext_repr() { return string("()"); }
+#ifdef DEBUG
+string EmptyList::_debug_repr() { return ext_repr(); }
+#endif
+
+bool FrameObj::is_ret_addr() { 
+    return ftype == CLS_RET_ADDR;
+}
+
+EvalObj::EvalObj() : FrameObj() { ftype = CLS_EVAL_OBJ; }
+void EvalObj::prepare(Cons *pc) {}
+bool EvalObj::is_simple_obj() {
+    return otype == CLS_SIM_OBJ;
+}
+
+bool EvalObj::is_true() {
+    return true;
+}
+
+Cons::Cons(EvalObj *_car, Cons *_cdr) : EvalObj(), car(_car), cdr(_cdr), skip(false), next(NULL) {}
+
+string Cons::ext_repr() { return string("#<Cons>"); }
+#ifdef DEBUG
+string Cons::_debug_repr() { return ext_repr(); }
+Cons::_debug_print() {
+    printf("%s",
+    ("car: " + car -> ext_repr() + "\n" + \
+     "cdr: " + cdr -> ext_repr() + "\n").c_str());
+}
+#endif
+
+RetAddr::RetAddr(Cons *_addr) : FrameObj(), addr(_addr) {
+    ftype = CLS_RET_ADDR;
+}
+
+UnspecObj::UnspecObj() : EvalObj() {}
+string UnspecObj::ext_repr() { return string("#<Unspecified>"); }
+#ifdef DEBUG
+string UnspecObj::_debug_repr() { return ext_repr(); }
+#endif
+
+SymObj::SymObj(string str) : EvalObj(), val(str) {}
+string SymObj::ext_repr() { return "#<Symbol: " + val + ">"; }
+#ifdef DEBUG
+string SymObj::_debug_repr() { return ext_repr(); }
+#endif
+
+OptObj::OptObj() : EvalObj() {}
+
+ProcObj::ProcObj(ASTList *_body, 
+                    Environment *_envt, 
+                    SymbolList *_para_list) :
+    OptObj(), body(_body), envt(_envt), para_list(_para_list) {}
+
+Cons *ProcObj::call(ArgList *arg_list, Environment * &envt,
+                    Continuation * &cont, FrameObj ** &top_ptr) {
+    // Create a new continuation
+    Cons *ret_addr = dynamic_cast<Cons*>(*top_ptr);
+    Continuation *ncont = new Continuation(envt, ret_addr, cont, body);
+    cont = ncont;                   // Add to the cont chain
+    envt = new Environment(envt);   // Create local env and recall the closure
+    // TODO: Compare the arguments to the parameters
+    for (Cons *ptr = arg_list->cdr, *ppar = para_list; 
+            ptr != empty_list; ptr = ptr->cdr)
+        envt->add_binding(dynamic_cast<SymObj*>(ppar->car), ptr->car);
+    *top_ptr = new RetAddr(NULL);   // Mark the entrance of a cont
+    return body;                    // Move pc to the proc entry point
+}
+
+string ProcObj::ext_repr() { return string("#<Procedure"); }
+#ifdef DEBUG
+string ProcObj::_debug_repr() { return ext_repr(); }
+#endif
+
+SpecialOptObj::SpecialOptObj() : OptObj() {}
+
+NumberObj::NumberObj() : EvalObj() {}
+
+BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
+    OptObj(), handler(f), name(_name) {}
+
+Cons *BuiltinProcObj::call(ArgList *arg_list, Environment * &envt,
+                                Continuation * &cont, FrameObj ** &top_ptr) {
+
+    Cons *ret_addr = dynamic_cast<Cons*>(*top_ptr);
+    *top_ptr = handler(arg_list->cdr);
+    return ret_addr->next;          // Move to the next instruction
+}
+
+Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) {}
+void Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj) {
+    binding[sym_obj->val] = eval_obj;
+}
+EvalObj *Environment::get_obj(SymObj *sym_obj) {
+    string name(sym_obj->val);
+    for (Environment *ptr = this; ptr; ptr = prev_envt)
+    {
+        bool has_key = binding.count(name);
+        if (has_key) return binding[name];
+    }
+    //TODO: exc key not found
+}
+bool Environment::has_obj(SymObj *sym_obj) {
+    string name(sym_obj->val);
+    for (Environment *ptr = this; ptr; ptr = prev_envt)
+        if (binding.count(name))
+            return true;
+    return false;
+}
+
+Continuation::Continuation(Environment *_envt, Cons *_pc, 
+                            Continuation *_prev_cont, 
+                            ASTList *_proc_body, 
+                            unsigned int _body_cnt) : 
+        envt(_envt), pc(_pc), prev_cont(_prev_cont), 
+        proc_body(_proc_body), body_cnt(_body_cnt) {}
diff --git a/model.h b/model.h
new file mode 100644
index 0000000..42765ba
--- /dev/null
+++ b/model.h
@@ -0,0 +1,226 @@
+#ifndef MODEL_H
+#define MODEL_H
+
+#include <string>
+#include <list>
+#include <map>
+
+using std::list;
+using std::string;
+using std::map;
+
+typedef unsigned char ClassType;  // that range is enough
+
+static const int CLS_RET_ADDR = 0;
+static const int CLS_EVAL_OBJ = 1;
+static const int CLS_SIM_OBJ = 0;
+static const int CLS_CONS_OBJ = 1;
+
+/** @class FrameObj
+ * Objects that can be held in the evaluation stack
+ */
+class FrameObj {
+    protected:
+        ClassType ftype;   // avoid the use of dynamic_cast to improve efficiency
+    public:
+        virtual ~FrameObj() {}
+        bool is_ret_addr();
+#ifdef DEBUG
+        virtual string _debug_repr() = 0;  
+#endif
+};
+
+
+class Cons;
+/** @class EvalObj
+ * Objects that represents a value in evaluation
+ */
+class EvalObj : public FrameObj {
+    private:
+        ClassType otype;    // avoid the use of dynamic_cast to improve efficiency
+    public:
+        EvalObj();
+        bool is_simple_obj();
+        /** External representation of this object */
+        virtual void prepare(Cons *pc);
+        virtual string ext_repr() = 0;  
+        /**< Always true for all EvalObjs except BoolObj */
+        virtual bool is_true();         
+};
+
+/** @class Cons
+ * Pair construct, which can be used to represent a list, or further
+ * more, a syntax tree
+ * (car . cdr) in Scheme
+ */
+class Cons : public EvalObj {
+    public:
+        EvalObj *car;                   /**< car (as in Scheme) */
+        Cons *cdr;                      /**< cdr (as in Scheme) */
+        bool skip;                      /**< Wether to skip the current branch */
+        Cons* next;                      /**< The next branch in effect         */
+
+        Cons(EvalObj *, Cons *);
+#ifdef DEBUG
+        void _debug_print();
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class EmptyList
+ * The empty list (special situation of a list)
+ */
+class EmptyList: public Cons {
+    public:
+        EmptyList();
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class RetAddr
+ * Tracking the caller's Cons pointer
+ */
+class RetAddr : public FrameObj {
+    public:
+        Cons* addr;                      /**< The return address  */
+
+        RetAddr(Cons *);
+};
+
+
+/** @class UnspecObj
+ * The "unspecified" value returned by some builtin procedures
+ */
+class UnspecObj: public EvalObj {
+    public:
+        UnspecObj();
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class SymObj
+ * Symbols
+ */
+class SymObj: public EvalObj {
+    public:
+        string val;
+
+        SymObj(string);
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+// Everything is cons
+typedef Cons ASTList;
+typedef Cons SymbolList;
+typedef Cons ArgList;
+class Environment;
+class Continuation;
+
+/** @class OptObj
+ * "Operators" in general sense
+ */
+class OptObj: public EvalObj {
+    public:
+        OptObj();
+        /**
+         * The function is called when an operation is needed.
+         * @param arg_list The argument list (the first one is the opt itself)
+         * @param envt The current environment (may be modified)
+         * @param cont The current continuation (may be modified)
+         * @param top_ptr Pointing to the top of the stack (may be modified)
+         * @return New value for pc register 
+         */
+        virtual Cons *call(ArgList *arg_list, Environment * &envt, 
+                            Continuation * &cont, FrameObj ** &top_ptr) = 0;
+};
+
+/** @class ProcObj
+ * User-defined procedures
+ */
+class ProcObj: public OptObj {
+    public:
+        /** The procedure body, a list of expressions to be evaluated */
+        ASTList *body;        
+        /** The arguments, a list of Symbols */
+        SymbolList *para_list;
+        /** Pointer to the environment */
+        Environment *envt;
+
+        ProcObj(ASTList *, Environment *, SymbolList *);
+        Cons *call(ArgList *arg_list, Environment * &envt,
+                    Continuation * &cont, FrameObj ** &top_ptr);
+#ifdef DEBUG
+        string _debug_repr();
+#endif
+        string ext_repr();
+};
+
+/** @class SpecialOptObj
+ * Special builtin syntax (`if`, `define`, `lambda`, etc.)
+ */
+class SpecialOptObj: public OptObj {
+    public:
+        SpecialOptObj();
+};
+
+typedef EvalObj* (*BuiltinProc)(ArgList *);
+/** @class BuiltinProcObj
+ * Wrapping class for builtin procedures (arithmetic operators, etc.)
+ */
+class BuiltinProcObj: public OptObj {
+    private:
+        /** The function that tackle the inputs in effect */
+        BuiltinProc handler;        
+        string name;
+    public:
+        BuiltinProcObj(BuiltinProc, string);
+        Cons *call(ArgList *arg_list, Environment * &envt,
+                    Continuation * &cont, FrameObj ** &top_ptr);
+};
+
+/** @class NumberObj
+ * The top level abstract of numbers
+ */
+
+class NumberObj: public EvalObj {
+    public:
+        NumberObj();
+};
+
+typedef map<string, EvalObj*> Str2EvalObj;
+/** @class Environment
+ * The environment of current evaluation, i.e. the local variable binding 
+ */
+class Environment {
+    private:
+        Environment *prev_envt; /**< Pointer to the upper level environment */
+        Str2EvalObj binding;    /**< Store all pairs of identifier and its
+                                  corresponding obj */
+    public:
+        Environment(Environment * = NULL);
+        void add_binding(SymObj *, EvalObj *);  
+        EvalObj *get_obj(SymObj *);
+        bool has_obj(SymObj *);
+};
+
+class Continuation {
+    public:
+        Continuation *prev_cont;
+        Environment *envt;
+        Cons *pc;
+        ASTList *proc_body;
+        unsigned int body_cnt;
+
+        Continuation(Environment *, Cons *, Continuation *, 
+                ASTList *, unsigned int = 0);
+};
+
+#endif
diff --git a/prototype/sketch.py b/prototype/sketch.py
old mode 100644
new mode 100755
index c2007ee..c51dad0
--- a/prototype/sketch.py
+++ b/prototype/sketch.py
@@ -164,7 +164,7 @@ class _builtin_lambda(SpecialOptObj):
 
     def call(self, arg_list, envt, cont, stack, top, ret_addr):
         pc = ret_addr.car
-        para_list = list()              # paramter list
+        para_list = list()              # paramter list TODO: use Cons to represent list
         par = pc.cdr.car                # Switch to the first parameter
         while not (par is empty_list): 
             para_list.append(par.car)
@@ -175,7 +175,7 @@ class _builtin_lambda(SpecialOptObj):
 
         pc = pc.cdr.cdr     # Move pc to procedure body
         #TODO: check body
-        body = list()       # store a list of expressions inside <body>
+        body = list()       # store a list of expressions inside <body> TODO: Cons
 
         while not (pc is empty_list):
             body.append(pc)
-- 
cgit v1.2.3