├── .etags
├── .gitignore
├── CMakeLists.txt
├── LispChar.cpp
├── LispChar.h
├── LispCons.cpp
├── LispCons.h
├── LispEnv.cpp
├── LispEnv.h
├── LispEval.cpp
├── LispEval.h
├── LispFixNum.cpp
├── LispFixNum.h
├── LispFloatNum.cpp
├── LispFloatNum.h
├── LispLambda.cpp
├── LispLambda.h
├── LispNil.cpp
├── LispNil.h
├── LispObj.cpp
├── LispObj.h
├── LispPrimitive.cpp
├── LispPrimitive.h
├── LispPrinter.cpp
├── LispPrinter.h
├── LispQuote.cpp
├── LispQuote.h
├── LispReader.cpp
├── LispReader.h
├── LispString.cpp
├── LispString.h
├── LispSymbol.cpp
├── LispSymbol.h
├── Main.cpp
├── Scanner.h
├── TODO.org
└── test.in


/.etags:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/johnfredcee/lispp/81f5ef2dba7bf0be383189e50b5650d48233b6af/.etags


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | # ignore objects and archives, anywhere in the tree.
2 | *.[oa]
3 | TAGS
4 | *.dblite
5 | *.desktop
6 | *.lock


--------------------------------------------------------------------------------
/CMakeLists.txt:
--------------------------------------------------------------------------------
 1 | cmake_minimum_required (VERSION 2.8)
 2 | project (Lispp)
 3 | 
 4 | file(GLOB lispp_src "Lisp*.cpp")
 5 | set(Boost_DEBUG 1)
 6 | set(Boost_USE_STATIC_LIBS ON) 
 7 | set(Boost_USE_MULTITHREADED ON)  
 8 | set(Boost_USE_STATIC_RUNTIME ON) 
 9 | find_package(Boost REQUIRED COMPONENTS log_setup log date_time atomic filesystem system thread)
10 | include_directories(${Boost_INCLUDE_DIRS}) 
11 | add_executable(lispp "Main.cpp" ${lispp_src})
12 | target_link_libraries(lispp ${Boost_LIBRARIES})                        
13 | 


--------------------------------------------------------------------------------
/LispChar.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <list>
 5 | #include <vector>
 6 | #include <iostream>
 7 | #include <string>
 8 | 
 9 | #include "LispObj.h"
10 | #include "LispFixNum.h"
11 | 
12 | namespace Lisp {
13 | LispObjRef make_char(CChar val)
14 | {
15 | 	return boost::shared_ptr<LispObj>(new LispObj(val));
16 | }
17 | 
18 | bool is_char(LispObjRef obj)
19 | {
20 | 	return (obj->which() == CHAR);
21 | }
22 | }
23 | 


--------------------------------------------------------------------------------
/LispChar.h:
--------------------------------------------------------------------------------
 1 | #ifndef LISPCHAR_H
 2 | #define LISPCHAR_H
 3 | 
 4 | namespace Lisp
 5 | {
 6 | 	LispObjRef make_char(u8 val);
 7 | 	bool       is_char(LispObjRef obj); 
 8 | }
 9 | 
10 | #endif
11 | 


--------------------------------------------------------------------------------
/LispCons.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <string>
 5 | #include <list>
 6 | #include <vector>
 7 | #include <iostream>
 8 | #include <utility>
 9 | 
10 | #include "LispObj.h"
11 | #include "LispNil.h"
12 | #include "LispCons.h"
13 | 
14 | namespace Lisp
15 | {
16 | 
17 | LispObjRef make_cons(LispObjRef car, LispObjRef cdr) {
18 | 	return boost::shared_ptr<LispObj>(new LispObj(std::pair<LispObjRef, LispObjRef>(car,cdr)));
19 | }
20 | 
21 | LispObjRef car(LispObjRef cons) {
22 | 	assert(is_cons(cons));
23 | 	return get_ctype<ConsType>(cons).first;
24 | }
25 | 
26 | LispObjRef cdr(LispObjRef cons) {
27 | 	assert(is_cons(cons));
28 | 	return get_ctype<ConsType>(cons).second;
29 | }
30 | 
31 | LispObjRef cadr(LispObjRef cons) {
32 | 	assert(is_cons(cons));
33 | 	LispObjRef ncar = get_ctype<ConsType>(cons).second;
34 | 	assert(is_cons(ncar) | is_nil(ncar));
35 | 	return !is_nil(ncar) ? car(ncar) : nil;
36 | }
37 | 
38 | LispObjRef cddr(LispObjRef cons) {
39 | 	assert(is_cons(cons));
40 | 	LispObjRef ncar = get_ctype<ConsType>(cons).second;
41 | 	assert(is_cons(ncar));
42 | 	ncar = get_ctype<ConsType>(cons).second;	
43 | 	return ncar;
44 | }
45 | 
46 | bool is_cons(LispObjRef obj) {
47 | 	return (obj->which() == CONS);
48 | }
49 | 
50 | }
51 | 


--------------------------------------------------------------------------------
/LispCons.h:
--------------------------------------------------------------------------------
 1 | #if !defined(H_LISPCONS)
 2 | #define H_LISPCONS
 3 | 
 4 | 
 5 | namespace Lisp
 6 | {
 7 | 
 8 | LispObjRef make_cons(LispObjRef car, LispObjRef cdr);
 9 | LispObjRef car(LispObjRef cons);
10 | LispObjRef cdr(LispObjRef cons);
11 | LispObjRef cadr(LispObjRef cons);
12 | LispObjRef cddr(LispObjRef cons);
13 | bool	   is_cons(LispObjRef obj);
14 | 
15 | }
16 | 
17 | #endif
18 | 
19 | 


--------------------------------------------------------------------------------
/LispEnv.cpp:
--------------------------------------------------------------------------------
  1 | 
  2 | // TO DO : Need c-set-style to ensure consistent formatting
  3 | 
  4 | #include "LispObj.h"
  5 | #include "LispEnv.h"
  6 | #include "LispNil.h"
  7 | #include "LispQuote.h"
  8 | #include "LispCons.h"
  9 | #include "LispSymbol.h"
 10 | #include "LispPrimitive.h"
 11 | #include "LispPrinter.h"
 12 | #include "LispEval.h"
 13 | #include "LispLambda.h"
 14 | 
 15 | using namespace std;
 16 | 
 17 | namespace Lisp {
 18 | 
 19 | // there is one global ennvironment at the root of everything
 20 | LispEnvRef LispEnv::globalEnv = LispEnvRef(new LispEnv);
 21 | 
 22 | // constructor - new environment is constructed referring to
 23 | // it's parent, normally, but this is for the global environment
 24 | LispEnv::LispEnv() : parent_(LispEnvRef()) {
 25 | 	fEnv_["QUOTE"]   = make_literal(PrimType(LispQuote::quote_fn));
 26 | 	fEnv_["SET!"]    = make_literal(PrimType(LispEnv::set_fn));
 27 | 	fEnv_["DEFINE"]  = make_literal(PrimType(LispEnv::define_fn));
 28 | 	fEnv_["FN"]      = make_literal(PrimType(LispEnv::defun_fn));
 29 | 	fEnv_["CAR"]     = make_literal(PrimType(LispEnv::car_fn));
 30 | 	fEnv_["CDR"]     = make_literal(PrimType(LispEnv::cdr_fn));
 31 | 	fEnv_["PRINT"]   = make_literal(PrimType(LispEnv::print_fn));
 32 | 	fEnv_["LAMBDA"]  = make_literal(PrimType(LispEnv::lambda_fn));
 33 | 	fEnv_["IF"]      = make_literal(PrimType(LispEnv::if_fn));
 34 | 	fEnv_["PROGN"]   = make_literal(PrimType(LispEnv::prog_fn));
 35 | }
 36 | 
 37 | // constructor - new environment created with parent
 38 | LispEnv::LispEnv(LispEnvRef parentEnv) : parent_(parentEnv) {
 39 | }
 40 | 
 41 | // resolve a reference to a symbol in an environment
 42 | // corresponds to lookup-variable-value in sicp
 43 | LispObjRef LispEnv::ref(std::string var)  {
 44 | 	EnvironmentT::iterator it(env_.find(var));
 45 | 	if(it != env_.end()) {
 46 | 		return it->second;
 47 | 	};
 48 | 	if(parent_ != NULL) {
 49 | 		return parent_->ref(var);
 50 | 	}
 51 | 	return nil;
 52 | }
 53 | 
 54 | // bind a symnbol to a variable in this environment
 55 | // corresponts to set-variable-value! in sicp
 56 | LispObjRef LispEnv::set(std::string var, LispObjRef ref) {
 57 | 	EnvironmentT::iterator it(env_.find(var));
 58 | 	if(it != env_.end()) {
 59 | 		it->second = ref;
 60 | 		return ref;
 61 | 	} else {
 62 | 		env_[var] = ref;
 63 | 	}
 64 | 	return nil;
 65 | }
 66 | 
 67 | // bind a symnbol to a variable in this environment
 68 | LispObjRef LispEnv::define(std::string var, LispObjRef ref) {
 69 | 	EnvironmentT::iterator it(env_.find(var));
 70 | 	if(it != env_.end()) {
 71 | 		it->second = ref;
 72 | 	} else {
 73 | 		env_[var] = ref;
 74 | 	}
 75 | 	return ref;
 76 | }
 77 | 
 78 | // resolve a reference to a function in an environment
 79 | LispObjRef LispEnv::fref(std::string var)  {
 80 | 	EnvironmentT::iterator it(fEnv_.find(var));
 81 | 	if(it != fEnv_.end()) {
 82 | 		return it->second;
 83 | 	};
 84 | 	if(parent_ != NULL) {
 85 | 		return parent_->fref(var);
 86 | 	}
 87 | 	return nil;
 88 | }
 89 | 
 90 | // set the value associated with a symbol in an environment
 91 | LispObjRef LispEnv::fset(std::string var, LispObjRef ref) {
 92 | 	fEnv_[var] = ref;
 93 | 	return ref;
 94 | }
 95 | 
 96 | // Function used for the (set ) special form - bind car to cons
 97 | LispObjRef LispEnv::set_fn(LispObjRef cons, LispEnvRef env) {
 98 | 	// car of cons should be a symbol
 99 | 	if(is_symbol(car(cons)))
100 | 		return env->set(get_ctype<SymbolType>(car(cons)).name, eval(cadr(cons), env));
101 | 	return nil;
102 | }
103 | 
104 | LispObjRef LispEnv::define_fn(LispObjRef cons, LispEnvRef env) {
105 | 	if(is_symbol(car(cons)))
106 | 		return env->define(get_ctype<SymbolType>(car(cons)).name, eval(cadr(cons), env));
107 | 	return nil;
108 | }
109 | 
110 | LispObjRef LispEnv::defun_fn(LispObjRef cons, LispEnvRef env) {
111 | 	if(is_symbol(car(cons)))
112 | 		env->fset(get_ctype<SymbolType>(car(cons)).name, eval(cadr(cons), env));
113 | 	return car(cons);
114 | }
115 | 
116 | LispObjRef LispEnv::car_fn(LispObjRef cons, LispEnvRef env) {
117 | 	return car(eval(cadr(cons), env));
118 | }
119 | 
120 | LispObjRef LispEnv::cdr_fn(LispObjRef cons, LispEnvRef env) {
121 | 	return cdr(eval(cadr(cons), env));
122 | }
123 | 
124 | LispObjRef LispEnv::print_fn(LispObjRef cons, LispEnvRef env) {
125 | 	Printer::printer->print(eval(cadr(cons), env));
126 | 	return nil;
127 | }
128 | 
129 | LispObjRef LispEnv::lambda_fn(LispObjRef cons, LispEnvRef env) {
130 | 	(void) env;
131 | 	// really just returns an unevaluated cons
132 | 	LispObjRef args = car(cons);
133 | 	LispObjRef body = car(cdr(cons));
134 | 	return make_lambda(args, body);
135 | }
136 | 
137 | LispObjRef LispEnv::apply_fn(LispObjRef cons, LispEnvRef env) {
138 | 	LispObjRef result = nil;
139 | 	// should be a cons cell [apply|-]-[fn|-]-[arg0|-]-[arg1|-]-...
140 | 	LispObjRef obj = eval(cadr(cons), env);
141 | 	// [fn|-]-[arg0|-]-[arg1|-]-...||
142 |     // [.|-]-[arg0|-]-[arg1]-[
143 | 	// [lambda|-]-
144 | 	if (is_cons(obj)) 
145 | 	{
146 | 		// must be function invocation -- function symbol
147 | 		LispObjRef fnsym(car(obj));		
148 | 		if (is_symbol(fnsym) || is_primitive(fnsym)) {
149 | 			// it's a function
150 | 			LispObjRef fn = is_symbol(fnsym) ? env->fref(get_ctype<SymbolType>(fnsym).name) : fnsym; 
151 | 			if (is_primitive(fn)) {
152 | 				CPrim cfn = (CPrim)(boost::get<PrimType>(*fn));
153 | 				// call it on the cdr
154 | 				result = cfn(cdr(obj), env);
155 | 			}
156 | 		}
157 | 		if (is_cons(fnsym)) {
158 | 			LispObjRef lambda(eval(car(fnsym), env));
159 | 			if (is_cons(lambda)) {
160 | 				// this should be a lambda form - args are car, cdr is body
161 | 				LispObjRef params = car(lambda);
162 | 				LispObjRef args   = cddr(obj);
163 | 				LispEnvRef lambda_env(new LispEnv(env));				
164 | 				LispObjRef param;
165 | 				LispObjRef arg;				
166 | 				do {
167 | 					param = car(params);
168 | 					arg = car(args);
169 | 					lambda_env->set(get_ctype<SymbolType>(param).name, eval(arg,env));					
170 | 					param = cadr(params);
171 | 					arg = is_nil(arg) ? nil : cadr(args);					
172 | 				} while (!is_nil(param));
173 | 				result = eval(cdr(lambda), lambda_env); 
174 | 			}
175 | 		}
176 | 	}	
177 | 	return result;
178 | }
179 | 
180 | LispObjRef  LispEnv::if_fn(LispObjRef cons, LispEnvRef env) {
181 | 	LispObjRef condition = car(cons);
182 | 	LispObjRef result = eval(condition, env);
183 | 	LispObjRef trueclause = cadr(cons);
184 | 	LispObjRef falseclause = car(cdr(cdr(cons)));
185 | 	if(!is_nil(result)) {
186 | 		return eval(trueclause, env);
187 | 	} else {
188 | 		return eval(falseclause, env);
189 | 	}
190 | }
191 | 
192 | LispObjRef LispEnv::prog_fn(LispObjRef cons, LispEnvRef env) {
193 | 	LispObjRef result = nil;
194 | 	LispObjRef fnx = cons;
195 | 	while(!is_nil(fnx)) {
196 | 		LispObjRef arg = car(fnx);
197 | 		result = eval(arg, env);
198 | 		fnx = cdr(fnx);
199 | 	}
200 | 	return result;
201 | }
202 | } // namespace Lisp
203 | 
204 | 


--------------------------------------------------------------------------------
/LispEnv.h:
--------------------------------------------------------------------------------
 1 | #ifndef LISPENV_H
 2 | #define LISPENV_H
 3 | 
 4 | #include <string>
 5 | #include <boost/tr1/memory.hpp>
 6 | #include <boost/unordered_map.hpp>
 7 | #include "LispObj.h"
 8 | 
 9 | namespace Lisp {
10 | class LispEnv;
11 | 
12 | typedef boost::shared_ptr<LispEnv> LispEnvRef;
13 | 
14 | class LispEnv {
15 | public:
16 | 	typedef boost::unordered_map<std::string, LispObjRef> EnvironmentT;
17 | 
18 | 	/** construct root environment */
19 | 	LispEnv();
20 | 
21 | 	/** construct child environment from parent */
22 | 	LispEnv(LispEnvRef parentEnv);
23 | 
24 | 	/** fetch var in environment */
25 | 	LispObjRef ref(std::string var);
26 | 
27 | 	/** Set a var in the environment */
28 | 	LispObjRef set(std::string var, LispObjRef ref);
29 | 
30 | 	/** define a var in the environment */
31 | 	LispObjRef define(std::string var, LispObjRef ref);
32 | 
33 | 	/** fetch function in environment */
34 | 	LispObjRef fref(std::string var);
35 | 
36 | 	/** Set a function in the environment */
37 | 	LispObjRef fset(std::string var, LispObjRef ref);
38 | 
39 | 	/** Set function primitive */
40 | 	static LispObjRef set_fn(LispObjRef cons, LispEnvRef env);
41 | 
42 | 	/** Set function primitive */
43 | 	static LispObjRef define_fn(LispObjRef cons, LispEnvRef env);
44 | 
45 | 	/** Set function primitive */
46 | 	static LispObjRef defun_fn(LispObjRef cons, LispEnvRef env);
47 | 
48 | 	static  LispObjRef car_fn(LispObjRef cons, LispEnvRef env);
49 | 
50 | 	static  LispObjRef cdr_fn(LispObjRef cons, LispEnvRef  env);
51 | 
52 | 	static  LispObjRef print_fn(LispObjRef cons, LispEnvRef  env);
53 | 
54 | 	static LispObjRef apply_fn(LispObjRef cons, LispEnvRef env);
55 | 	
56 | 	static LispObjRef lambda_fn(LispObjRef cons, LispEnvRef env);
57 | 
58 | 	static LispObjRef if_fn(LispObjRef cons, LispEnvRef env);
59 | 
60 | 	static LispObjRef prog_fn(LispObjRef cons, LispEnvRef env);
61 | 
62 | 	/** Global environment */
63 | 	static LispEnvRef globalEnv;
64 | 
65 | private:
66 | 
67 | 	/** Our environemnt. */
68 | 	EnvironmentT env_;
69 | 
70 | 	/** Our function environment (yes, it's a Lisp-2) */
71 | 	EnvironmentT fEnv_;
72 | 
73 | 	/** Pointer back up to parent environment */
74 | 	LispEnvRef parent_;
75 | };
76 | 
77 | }
78 | #endif
79 | 
80 | 


--------------------------------------------------------------------------------
/LispEval.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include "LispObj.h"
 3 | #include "LispNil.h"
 4 | #include "LispChar.h"
 5 | #include "LispCons.h"
 6 | #include "LispEnv.h"
 7 | #include "LispFixNum.h"
 8 | #include "LispFloatNum.h"
 9 | #include "LispString.h"
10 | #include "LispSymbol.h"
11 | #include "LispPrimitive.h"
12 | #include "LispEval.h"
13 | #include "LispLambda.h"
14 | 
15 | namespace Lisp {
16 | 
17 | LispObjRef Eval::operator()(LispObjRef obj, LispEnvRef env, bool fplace) {
18 | 
19 | 	// trivial case :-)
20 | 	if (is_nil(obj))
21 | 	  return nil;
22 | 	// constant literal 
23 | 	if (is_char(obj) ||	is_fixnum(obj) || is_floatnum(obj) || is_string(obj) || is_primitive(obj))
24 | 	  return obj;
25 | 	// symbol lookup
26 | 	if (is_symbol(obj)) {
27 | 		LispObjRef result = fplace ? env->fref(get_ctype<SymbolType>(obj).name) : env->ref(get_ctype<SymbolType>(obj).name);
28 | 		return result;
29 | 	}
30 | 	// cons cell
31 | 	if (is_cons(obj)) 
32 | 	{
33 | 		// must be function invocation -- function symbol
34 | 		LispObjRef fnsym(eval(car(obj), env, is_symbol(car(obj))));
35 | 		if ((is_symbol(fnsym)) | (is_primitive(fnsym)))
36 | 		{	
37 | 			// it's a function
38 | 			if (is_primitive(fnsym)) {
39 | 				CPrim cfn = (CPrim)(boost::get<PrimType>(*fnsym));
40 | 				// call it on the cdr
41 | 				LispObjRef result = cfn(cdr(obj), env);
42 | 				return result;
43 | 			}
44 | 		}
45 | 		// else -- apply			
46 | 		if (is_lambda(fnsym)) {
47 | 			// fnsym is the lambda
48 | 			// cdr(obj) is the values applied
49 | 			LispObjRef params = cdr(obj);
50 | 			LispEnvRef newEnv(new LispEnv(env));
51 | 			LispObjRef args = get_ctype<LambdaType>(fnsym).args;
52 | 			while (!is_nil(args)) {
53 | 				LispObjRef param = car(params);
54 | 				LispObjRef arg = car(args);
55 | 				if (is_symbol(arg)) {
56 | 					newEnv->set(get_ctype<SymbolType>(arg).name,param);
57 | 				}
58 | 				if (is_cons(params))
59 | 					params = cdr(params);
60 | 				args = cdr(args);
61 | 			}
62 | 			return eval(get_ctype<LambdaType>(fnsym).body, newEnv);
63 | 			
64 | 		}		
65 | 	} 
66 | 	return nil;		
67 |   };
68 | }
69 | 


--------------------------------------------------------------------------------
/LispEval.h:
--------------------------------------------------------------------------------
 1 | #ifndef LISPEVAL_H
 2 | #define LISPEVAL_H
 3 | 
 4 | #include "LispEnv.h"
 5 | 
 6 | namespace Lisp {
 7 | 
 8 | class LispEnv;
 9 | 
10 | class Eval {
11 | public:		
12 | 	LispObjRef operator()(LispObjRef obj, LispEnvRef env = LispEnv::globalEnv, bool fplace = false);
13 | };
14 | 
15 | extern Lisp::Eval    eval;
16 | 
17 | }
18 | #endif
19 | 


--------------------------------------------------------------------------------
/LispFixNum.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <list>
 5 | #include <vector>
 6 | #include <iostream>
 7 | #include <string>
 8 | 
 9 | #include "LispObj.h"
10 | #include "LispFixNum.h"
11 | 
12 | namespace Lisp {
13 | 	LispObjRef make_fixnum(CFixnum val)
14 | 	{
15 | 		return boost::shared_ptr<LispObj>(new LispObj(FixnumType(val)));
16 | 	}
17 | 
18 | 	bool is_fixnum(LispObjRef obj)
19 | 	{
20 | 		return (obj->which() == FIXNUM);
21 | 	}	
22 | }
23 | 
24 | 


--------------------------------------------------------------------------------
/LispFixNum.h:
--------------------------------------------------------------------------------
 1 | 
 2 | #ifndef LISP_FIXNUM_H_INCLUDED
 3 | #define LISP_FIXNUM_H_INCLUDED
 4 | 
 5 | namespace Lisp
 6 | {
 7 | 	LispObjRef make_fixnum(CFixnum val);
 8 | 	bool       is_fixnum(LispObjRef obj); 
 9 | }
10 | 
11 | #endif
12 | 


--------------------------------------------------------------------------------
/LispFloatNum.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <list>
 5 | #include <vector>
 6 | #include <iostream>
 7 | #include <string>
 8 | 
 9 | #include "LispObj.h"
10 | #include "LispEnv.h"
11 | #include "LispFloatNum.h"
12 | 
13 | 
14 | namespace Lisp {
15 | 	LispObjRef make_floatnum(CFloatnum  val)
16 | 	{
17 | 		return boost::shared_ptr<LispObj>(new LispObj(val));
18 | 	}
19 | 
20 | 	bool is_floatnum(LispObjRef obj)
21 | 	{
22 | 		return (obj->which() == FLOATNUM);
23 | 	}	
24 | }
25 | 
26 | 


--------------------------------------------------------------------------------
/LispFloatNum.h:
--------------------------------------------------------------------------------
 1 | 
 2 | #ifndef LISP_FLOATNUM_H_INCLUDED
 3 | #define LISP_FLOATNUM_H_INCLUDED
 4 | 
 5 | namespace Lisp
 6 | {
 7 | 	LispObjRef make_floatnum(CFloatnum val);
 8 | 	bool       is_floatnum(LispObjRef obj); 
 9 | }
10 | 
11 | #endif
12 | 


--------------------------------------------------------------------------------
/LispLambda.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <string>
 5 | #include <list>
 6 | #include <vector>
 7 | #include <iostream>
 8 | #include <utility>
 9 | 
10 | #include "LispObj.h"
11 | #include "LispNil.h"
12 | #include "LispCons.h"
13 | #include "LispLambda.h"
14 | 
15 | namespace Lisp
16 | {
17 | 
18 | LispObjRef make_lambda(LispObjRef args, LispObjRef body) {
19 | 	return boost::shared_ptr<LispObj>(new LispObj(Lambda(args,body)));
20 | }
21 | 
22 | LispObjRef args(LispObjRef lambda) {
23 | 	assert(is_lambda(lambda));
24 | 	return get_ctype<LambdaType>(lambda).args;
25 | }
26 | 
27 | LispObjRef body(LispObjRef lambda) {
28 | 	assert(is_lambda(lambda));
29 | 	return get_ctype<LambdaType>(lambda).body;
30 | }
31 | 
32 | bool is_lambda(LispObjRef obj) {
33 | 	return (obj->which() == LAMBDA);
34 | }
35 | 
36 | }
37 | 


--------------------------------------------------------------------------------
/LispLambda.h:
--------------------------------------------------------------------------------
 1 | #if !defined(H_LISPLAMBDA)
 2 | #define H_LISPLAMBDA
 3 | 
 4 | 
 5 | namespace Lisp
 6 | {
 7 | 
 8 | LispObjRef make_lambda(LispObjRef args, LispObjRef bodt);
 9 | LispObjRef args(LispObjRef lambda);
10 | LispObjRef body(LispObjRef lambda);
11 | bool	   is_lambda(LispObjRef obj);
12 | 
13 | }
14 | 
15 | #endif
16 | 
17 | 
18 | 
19 | 


--------------------------------------------------------------------------------
/LispNil.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <list>
 5 | #include <vector>
 6 | #include <iostream>
 7 | #include <string>
 8 | 
 9 | #include "LispObj.h"
10 | #include "LispNil.h"
11 | 
12 | 
13 | namespace Lisp
14 | {
15 | 	LispObjRef nil = LispObjRef(new LispObj());
16 | 
17 | 	bool is_nil(LispObjRef obj) {
18 | 		return (obj->which() == NIL);
19 | 	}
20 | 
21 | }
22 | 


--------------------------------------------------------------------------------
/LispNil.h:
--------------------------------------------------------------------------------
 1 | #if !defined(H_LISPNIL)
 2 | #define H_LISPNIL
 3 | 
 4 | #include "LispObj.h"
 5 | 
 6 | namespace Lisp
 7 | {
 8 |     // the singulariy is here!
 9 | 	extern LispObjRef nil;
10 |     extern bool is_nil(LispObjRef obj);
11 | 
12 | }
13 | 
14 | 
15 | #endif
16 | 


--------------------------------------------------------------------------------
/LispObj.cpp:
--------------------------------------------------------------------------------
1 | 
2 | #include "LispObj.h"
3 | #include "LispEnv.h"
4 | 


--------------------------------------------------------------------------------
/LispObj.h:
--------------------------------------------------------------------------------
  1 | 
  2 | #ifndef H_LISP_OBJ
  3 | #define H_LISP_OBJ
  4 | 
  5 | #include <cassert>
  6 | #include <ostream>
  7 | #include <vector>
  8 | #include <map>
  9 | #include <string>
 10 | #include <algorithm>
 11 | #include <boost/variant.hpp>
 12 | #include <boost/shared_ptr.hpp>
 13 | 
 14 | namespace Lisp {
 15 | 
 16 | class LispEnv;
 17 | 
 18 | typedef boost::shared_ptr<LispEnv> LispEnvRef;
 19 | 
 20 | typedef signed char s8;
 21 | typedef signed short s16;
 22 | typedef signed int s32;
 23 | typedef signed long s64;
 24 | typedef signed long long s128;
 25 | 
 26 | typedef unsigned char u8;
 27 | typedef unsigned short u16;
 28 | typedef unsigned int u32;
 29 | typedef unsigned long u64;
 30 | typedef unsigned long long u128;
 31 | 
 32 | typedef float f32;
 33 | typedef double f64;
 34 | 
 35 | // forward declaration
 36 | class LispObj;
 37 | 
 38 | typedef boost::shared_ptr<LispObj> LispObjRef;
 39 | 
 40 | typedef s32 CFixnum;
 41 | typedef u8  CChar;
 42 | typedef std::string CString;
 43 | typedef f32 CFloatnum; 
 44 | 
 45 | // placeholder type
 46 | class NullType {
 47 | private:
 48 |   const u32 dead_;
 49 | public:
 50 |   NullType() :dead_(0xDEADBEEF) {
 51 |   }
 52 | };
 53 | 
 54 | /* This is a template for an unboxed type that can be represented by a simple scalar */
 55 | template <typename T> class TLispType {
 56 | private:
 57 | 	T data_;
 58 | public:
 59 | 	typedef T CType;
 60 | 	
 61 | 	TLispType<T>() {
 62 | 	}
 63 | 	  
 64 | 	explicit TLispType<T>(const T& other) : data_(other) {
 65 | 	}
 66 | 
 67 | 	T& operator=(const T& other) {
 68 | 		data_ = other;
 69 | 	}
 70 | 	  
 71 | 	TLispType(const TLispType<T>& other) : data_(other.data_) {
 72 | 	}
 73 | 	  
 74 | 	T& operator=(const TLispType<T>& other) {			
 75 | 		data_ = other.data_;
 76 | 		return *this;
 77 | 	}
 78 | 	  
 79 | 	// unboxed types can be freely converted to C++ type
 80 | 	operator T() {
 81 | 		return data_;
 82 | 	}
 83 | };
 84 | 
 85 | /**
 86 |  * LispPrimitive is a pointer to a function that returns a reference to 
 87 |  * a lisp obj and takes in a lisp obj. 
 88 |  */
 89 | typedef LispObjRef (*CPrim)(LispObjRef args, LispEnvRef env);
 90 | 
 91 | /* symbol : a name that references an object */ 
 92 | struct LispSymbol
 93 | {
 94 | 	std::string name;
 95 | 	LispObjRef value;
 96 | 	
 97 | 	LispSymbol(const std::string& n, const LispObjRef& v) : name(n), value(v)
 98 | 	{
 99 | 	};
100 | 
101 |   LispSymbol(const LispSymbol& sym) : name(sym.name), value(sym.value)
102 |  {
103 |  }
104 | };
105 | 
106 | 
107 | /* byte */
108 | typedef TLispType<CChar> CharType;
109 | 
110 | /* fixnum */
111 | typedef TLispType<CFixnum> FixnumType;
112 | 
113 | /* float */
114 | typedef TLispType<CFloatnum> FloatnumType;
115 | 
116 | /* string */
117 | typedef TLispType< CString	> StringType;
118 | 
119 | /* symbol */
120 | typedef TLispType< LispSymbol >	 SymbolType;
121 | 
122 | /* cons cell */
123 | typedef std::pair< LispObjRef, LispObjRef > CCons;
124 | typedef TLispType< CCons >  ConsType;
125 | 
126 | /** primitive */
127 | typedef	 TLispType< CPrim > PrimType;
128 | 
129 | /* lambda */
130 | typedef struct Lambda { LispObjRef args; LispObjRef body; Lambda() : args(LispObjRef()), body(LispObjRef()) {}; Lambda(LispObjRef a, LispObjRef b) : args(a), body(b) {}; } CLambda;
131 | 
132 | typedef TLispType< CLambda > LambdaType;
133 | 
134 | enum LispObjectType {
135 | 	NIL = 0,
136 | 	CHAR,
137 | 	FIXNUM,
138 | 	FLOATNUM,
139 | 	SYMBOL,
140 | 	STRING,
141 | 	CONS,
142 | 	PRIM,
143 | 	LAMBDA
144 | };
145 | 
146 | 	
147 | typedef	 boost::variant< NullType, CharType, FixnumType, FloatnumType, SymbolType, StringType, ConsType, PrimType, LambdaType > LispObjBase;
148 | 	
149 | class LispObj : public LispObjBase {
150 | public:
151 | 	LispObj() : LispObjBase() {
152 | 	}
153 | 	
154 | 	template <typename T>
155 | 	LispObj(const T& obj) : LispObjBase(TLispType<T>(obj)) {
156 | 	}
157 | 
158 | 	LispObj(const FixnumType& fnum) : LispObjBase(fnum) {
159 | 	}
160 | 
161 | 	LispObj(const FloatnumType& fnum) : LispObjBase(fnum) {		
162 | 	}
163 | 
164 | 	LispObj(const CharType& ch) : LispObjBase(ch) {
165 | 	}
166 | 	
167 | 	LispObj(const ConsType& cons) : LispObjBase(cons) {			
168 | 	}
169 | 
170 | 	LispObj(const StringType& string) : LispObjBase(string) {			
171 | 	}
172 | 
173 | 	LispObj(const SymbolType& symbol) : LispObjBase(symbol) {		   
174 | 	}
175 | 
176 | 	LispObj(const PrimType& primitive) : LispObjBase(primitive) {	
177 | 	}
178 | 
179 | 	LispObj(const LambdaType& lambda) : LispObjBase(lambda) {
180 | 	}
181 | };
182 | 
183 | template <typename T>
184 | inline LispObjRef make_literal(const T& literal)
185 | {
186 | 	return boost::shared_ptr<LispObj>(new LispObj(literal));
187 | }
188 | 
189 | typedef const char *cstrptr;
190 | 
191 | template <>
192 | inline LispObjRef make_literal(const cstrptr& literal)
193 | {
194 | 	std::string str(literal);
195 | 	return boost::shared_ptr<LispObj>(new LispObj(str));	
196 | }
197 | 
198 | template <class LT>
199 | inline typename LT::CType get_ctype(LispObjRef obj)
200 | {
201 | 	return ((typename LT::CType)(boost::get<LT>(*obj))); 
202 | }
203 | 
204 | 
205 | } // end namespace lisp
206 | 
207 | 
208 | 
209 | #endif
210 | 
211 | 
212 | 


--------------------------------------------------------------------------------
/LispPrimitive.cpp:
--------------------------------------------------------------------------------
 1 | #include "LispObj.h"
 2 | #include "LispPrimitive.h"
 3 | 
 4 | namespace Lisp {
 5 | 
 6 | bool is_primitive(LispObjRef obj) {
 7 | 	return (obj->which() == PRIM);
 8 | }
 9 | 
10 | }
11 | 


--------------------------------------------------------------------------------
/LispPrimitive.h:
--------------------------------------------------------------------------------
 1 | #ifndef LISPPRIMITIVE_H
 2 | #define LISPPRIMITIVE_H
 3 | 
 4 | #include "LispObj.h"
 5 | 
 6 | namespace Lisp {
 7 | extern bool is_primitive(LispObjRef obj);
 8 | }
 9 | #endif
10 | 


--------------------------------------------------------------------------------
/LispPrinter.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | #include <cctype>
 4 | #include "LispNil.h"
 5 | #include "LispFixNum.h"
 6 | #include "LispFloatNum.h"
 7 | #include "LispString.h"
 8 | #include "LispChar.h"
 9 | #include "LispSymbol.h"
10 | #include "LispReader.h"
11 | #include "LispCons.h"
12 | #include "LispPrinter.h"
13 | 
14 | using namespace std;
15 | 
16 | namespace Lisp {
17 | 
18 | 	Printer* Printer::printer = NULL;
19 | 
20 | 	Printer::Printer(ostream& output) : output_(output)
21 | 	{
22 | 		if (printer != NULL)
23 | 			return;
24 | 		printer = this;
25 | 	}
26 | 
27 | 	Printer::~Printer()
28 | 	{	
29 | 		printer = NULL;
30 | 	}
31 | 
32 | 	void Printer::print_cons(LispObjRef obj) {
33 | 		print(car(obj));
34 | 		LispObjRef next(cdr(obj));
35 | 		if (is_cons(next)) {
36 | 			output_ << " ";
37 | 			print_cons(next);					
38 | 			return;
39 | 		}
40 | 		if (is_nil(next)) {
41 | 			return;
42 | 		}
43 | 		output_ << " . ";
44 | 		print(next);
45 | 	}
46 | 
47 | 	void Printer::print(LispObjRef obj) {
48 | 		if (is_nil(obj))
49 | 			output_ << "NIL";
50 | 		else if (is_fixnum(obj))
51 | 			output_ << get_ctype<FixnumType>(obj); // (CFixnum)(boost::get<FixnumType>(*obj));
52 | 		else if (is_floatnum(obj))
53 | 			output_ <<  get_ctype<FloatnumType>(obj); //(CFloatnum)(boost::get<FloatnumType>(*obj));
54 | 		else if (is_string(obj))
55 | 			output_ << "\"" << get_ctype<StringType>(obj) << "\""; // ""(CString)(boost::get<StringType>(*obj)) << "\""; 
56 | 		else if (is_symbol(obj))
57 | 			output_ << get_ctype<SymbolType>(obj).name; // static_cast<LispSymbol>(boost::get<SymbolType>(*obj)).first;
58 | 		else if (is_cons(obj)) {
59 | 			output_ << "(";
60 | 			print_cons(obj);
61 | 			output_ << ")";			
62 | 		} else if (is_char(obj)) {
63 | 			CChar c = get_ctype<CharType>(obj);
64 | 			if (isprint(c)) {
65 | 				output_ << c;				
66 | 			} else {
67 | 				output_ << "#" << std::hex << (int) c << std::dec;
68 | 			}
69 | 		}
70 | 		else
71 | 			output_ << "#UNPRINTABLE#";
72 | 	}
73 | 
74 | 	void Printer::operator()(LispObjRef obj) {
75 | 		print(obj);
76 | 		output_ << endl;
77 | 	}
78 | }
79 | 
80 | 


--------------------------------------------------------------------------------
/LispPrinter.h:
--------------------------------------------------------------------------------
 1 | #ifndef LISPPRINTER_H
 2 | #define LISPPRINTER_H
 3 | 
 4 | #include <iostream>
 5 | #include <string>
 6 | #include "LispObj.h"
 7 | 
 8 | namespace Lisp
 9 | {
10 | 	class Printer {
11 | 	public:
12 | 		Printer(std::ostream& output);
13 | 		~Printer();
14 | 		void print_cons(LispObjRef cons);
15 | 		void print(LispObjRef obj);
16 | 		void operator()(LispObjRef obj);
17 | 		static Printer* printer;
18 | 	private:
19 | 		std::ostream& output_;		
20 | 	};
21 | }
22 | 
23 | 
24 | #endif
25 | 


--------------------------------------------------------------------------------
/LispQuote.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include "LispObj.h"
 3 | #include "LispEnv.h"
 4 | #include "LispQuote.h"
 5 | #include "LispCons.h"
 6 | 
 7 | namespace Lisp {
 8 | 
 9 |   LispObjRef LispQuote::quote_fn(LispObjRef cons, LispEnvRef env) {
10 | 	  return cons;		
11 |   }
12 | 
13 | }
14 | 


--------------------------------------------------------------------------------
/LispQuote.h:
--------------------------------------------------------------------------------
 1 | #ifndef LISPQUOTE_H
 2 | #define LISPQUOTE_H
 3 | 
 4 | #include "LispObj.h"
 5 | #include "LispEnv.h"
 6 | 
 7 | namespace Lisp {
 8 | 
 9 |   class LispQuote {
10 |   public:
11 | 	static LispObjRef quote_fn(LispObjRef cons, LispEnvRef env);
12 |   };
13 | 
14 | 
15 | }
16 | #endif
17 | 


--------------------------------------------------------------------------------
/LispReader.cpp:
--------------------------------------------------------------------------------
  1 | 
  2 | #include <boost/log/trivial.hpp>
  3 | #include <cctype>
  4 | #include "LispNil.h"
  5 | #include "LispFixNum.h"
  6 | #include "LispFloatNum.h"
  7 | #include "LispString.h"
  8 | #include "LispChar.h"
  9 | #include "LispSymbol.h"
 10 | #include "LispReader.h"
 11 | #include "LispCons.h"
 12 | #include "LispSymbol.h"
 13 | #include "LispEnv.h"
 14 | 
 15 | using namespace std;
 16 | 
 17 | 
 18 | namespace {
 19 | 
 20 | 	char hexval(char c) 
 21 | 	{
 22 | 		if ((c >= '0') && (c <= '9'))
 23 | 			return c - '0';
 24 | 		if ((c >= 'A') && (c <= 'F'))
 25 | 			return c - 'A';
 26 | 		if ((c >= 'a') && (c <= 'f'))
 27 | 			return c - 'a';
 28 | 		return 0;
 29 | 	}
 30 | 
 31 | }
 32 | 
 33 | namespace Lisp {
 34 | 
 35 | 	Reader::Reader(std::istream& input) :  tokenType_(UNKNOWN), input_(input)  
 36 | 	{
 37 | 	}
 38 | 
 39 | 	void Reader::whitespace()
 40 | 	{
 41 | 		char ic;
 42 | 
 43 | 		while (input_.good())
 44 | 		{
 45 | 			ic = input_.get();
 46 | 			if (isspace(ic))
 47 | 				continue;
 48 | 			if (ic == ';') 
 49 | 			{
 50 | 				while (input_.good()) {
 51 | 					ic = input_.get();
 52 | 					if (ic == '\n')
 53 | 						break;
 54 | 				}
 55 | 				continue;
 56 | 			}
 57 | 			if (!isspace(ic))
 58 | 				break;
 59 | 		}
 60 | 		input_.putback(ic);
 61 | 		return;
 62 | 	}
 63 | 
 64 | 	std::string Reader::readString() 
 65 | 	{
 66 | 		std::string result;
 67 | 		char ic = input_.get();
 68 | 		while ((input_.good()) && (ic != '\"')) 
 69 | 		{
 70 | 			if (ic != '\\') 
 71 | 			{
 72 | 				result = result + ic;			
 73 | 			}
 74 | 			else 
 75 | 			{
 76 | 				ic = input_.get();
 77 | 				result = result + ic;
 78 | 			}
 79 | 			ic = input_.get();
 80 | 		}
 81 | 		result = result;
 82 | 		return result;
 83 | 	}
 84 | 
 85 | 	// char literals
 86 | 	// either #\c - literal char c
 87 | 	// or     #8F - hex code 8F
 88 | 	std::string Reader::readChar()
 89 | 	{
 90 | 
 91 | 		std::string result;
 92 | 	
 93 | 		char ic = input_.get();
 94 | 		if (!input_.good())
 95 | 			result = "";
 96 | 		else {
 97 | 			if (ic == '\\')
 98 | 				result += input_.get();
 99 | 			else {
100 | 				char val = hexval(ic) * 16;
101 | 				ic = input_.get();
102 | 				if (input_.good()) {
103 | 					val += hexval(ic);
104 | 				}			
105 | 				result += val;
106 | 			}
107 | 		}
108 | 		return result;
109 | 	}
110 | 
111 | 	std::string Reader::readNumberOrSymbol(TokenType& type) {
112 | 		std::string result;
113 | 		type = FIXNUM;
114 | 		char ic = input_.get();
115 | 		if (isalpha(ic))
116 | 			type = SYMBOL;
117 | 		while((input_.good()) & (!isspace(ic)) && (ic!=')') && (ic!='(')) {
118 | 			result = result + ic;
119 | 			if ((type == FIXNUM) && (ic == '.')) {
120 | 				type = FLOATNUM;
121 | 			}
122 | 			ic = input_.get();
123 | 		}
124 | 		// if it was lexically important, stick it back
125 | 		if (!isspace(ic))
126 | 			input_.putback(ic);
127 | 		return result;
128 | 	}
129 | 
130 | 	std::string Reader::readQuote(TokenType& type) {
131 | 		std::string result = "QUOTE";
132 | 		type = QUOTE;
133 | 		return result;
134 | 	}
135 | 
136 | 	void Reader::nextToken() {
137 | 		char ic;
138 | 		tokenType_ = UNKNOWN;
139 | 		//BOOST_LOG_TRIVIAL(trace) << "Get next token";
140 | 		whitespace();
141 | 		while((input_.good()) && (tokenType_ == UNKNOWN))  {
142 | 			input_.get(ic);
143 | 			if(ic == ')') {
144 | 				tokenType_ = RPAREN;
145 | 				token_ = std::string(")");
146 | 				//BOOST_LOG_TRIVIAL(trace) << "RPAREN";
147 | 				break;
148 | 			}
149 | 			if(ic == '(') {
150 | 				tokenType_ = LPAREN;
151 | 				token_ = std::string("(");
152 | 				//BOOST_LOG_TRIVIAL(trace) << "LPAREN";
153 | 				break;
154 | 			}
155 | 			if (ic == '.') {
156 | 				tokenType_ = PERIOD;
157 | 				token_ = std::string(".");
158 | 				//BOOST_LOG_TRIVIAL(trace) << "PERIOD";
159 | 				break;
160 | 			}
161 | 			if(ic == '\"') {
162 | 				token_ = readString();
163 | 				//BOOST_LOG_TRIVIAL(trace) << "STRING";
164 | 				tokenType_ = STRING;
165 | 				break;
166 | 			}
167 | 			if(ic == '#') {
168 | 				//BOOST_LOG_TRIVIAL(trace) << "CHAR";
169 | 				token_ = readChar();
170 | 				tokenType_ = CHAR;
171 | 			}
172 | 			
173 | 			if(ic == '\'') {
174 | 				//BOOST_LOG_TRIVIAL(trace) << "QUOTE";
175 | 				token_ = readQuote(tokenType_);
176 | 				break;
177 | 			}			
178 | 			if(isalnum(ic)) {
179 | 				input_.putback(ic);
180 | 				token_ = readNumberOrSymbol(tokenType_);
181 | 			}
182 | 		}
183 | 		if(tokenType_ == UNKNOWN)
184 | 			tokenType_ = TERMINAL;
185 | 	}
186 | 
187 | 	bool Reader::isPeriodNext() {
188 | 		bool result = false;
189 | 		char ic;
190 | 		whitespace();
191 | 		if (input_.good()) {
192 | 			input_.get(ic);
193 | 			if (ic == '.') {
194 | 				result = true;
195 | 			} else {
196 | 				input_.putback(ic);
197 | 			}
198 | 		}
199 | 		return result;
200 | 	}
201 | 
202 | 	LispObjRef Reader::readToken() {
203 | 		nextToken();
204 | 		if (tokenType_ == TERMINAL) {
205 | 			return nil;
206 | 		}
207 | 		if (tokenType_ == FIXNUM) {
208 | 			return make_fixnum(atoi(token_.c_str()));
209 | 		}		
210 | 		if (tokenType_ == FLOATNUM) {
211 | 			return make_floatnum(atof(token_.c_str()));
212 | 		}
213 | 		if (tokenType_ == RPAREN) {
214 | 			return nil;
215 | 		}
216 | 		if (tokenType_ == LPAREN) {
217 | 			return nil;
218 | 		}
219 | 		if (tokenType_ == PERIOD) {
220 | 			return nil;
221 | 		}
222 | 		if (tokenType_ == SYMBOL) {
223 | 			if (token_ == std::string("NIL")) {
224 | 				return nil;
225 | 			} else {
226 | 				return make_symbol(token_.c_str());
227 | 			}
228 | 		}
229 | 		if (tokenType_ == CHAR) {
230 | 			return make_char(token_[0]);
231 | 		}
232 | 		if (tokenType_ == STRING) {
233 | 			return make_string(token_.c_str());
234 | 		}
235 | 		return nil;
236 | 	}
237 | 
238 | 	LispObjRef Reader::read_the_rest()
239 | 	{
240 | 		LispObjRef cdr = readToken();
241 | 		if (tokenType_ == RPAREN)
242 | 			return nil;
243 | 		if (tokenType_ == LPAREN)
244 | 			cdr = read_list();
245 | 		return make_cons(cdr, read_the_rest());
246 | 	}
247 | 
248 | 	LispObjRef Reader::read_list() 
249 | 	{
250 | 		LispObjRef car = read();	
251 | 		// empty list
252 | 		if (is_nil(car) && (tokenType_ == RPAREN))
253 | 			return nil;	 
254 | 		
255 | 		if (isPeriodNext()) {
256 | 			LispObjRef cdr = read();
257 | 			LispObjRef result =  make_cons(car,cdr);
258 | 			return result;
259 | 		} else {
260 | 			LispObjRef cdr = read_list();
261 | 			return make_cons(car, cdr);
262 | 		}
263 | 	}
264 | 
265 | 	LispObjRef Reader::read() {
266 | 		LispObjRef first = readToken();
267 | 		if ((tokenType_ != LPAREN) && (tokenType_ != QUOTE))
268 | 			return first;
269 | 		if (tokenType_ == QUOTE)
270 | 			return make_cons( LispEnv::globalEnv->fref("QUOTE"), 
271 | 							  read() );
272 | 		return read_list();
273 | 	}
274 | 
275 | 	LispObjRef Reader::operator()() {
276 | 		return read();
277 | 	}
278 | 
279 | 	Reader::~Reader() {
280 | 	}
281 | 
282 | } 
283 | 
284 | 


--------------------------------------------------------------------------------
/LispReader.h:
--------------------------------------------------------------------------------
 1 | #ifndef LISPREADER_H
 2 | #define LISPREADER_H
 3 | 
 4 | #include <iostream>
 5 | #include <string>
 6 | #include "LispObj.h"
 7 | 
 8 | namespace Lisp {
 9 | 	class Reader {
10 | 	public:
11 | 		enum TokenType {
12 | 			UNKNOWN,
13 | 			LPAREN,
14 | 			SYMBOL,
15 | 			STRING,
16 | 			CHAR,
17 | 			RPAREN,
18 | 			FIXNUM,
19 | 			FLOATNUM,
20 | 			PERIOD,
21 | 			QUOTE,
22 | 			TERMINAL
23 | 		};
24 | 
25 | 		Reader(std::istream& input);
26 | 
27 | 		virtual ~Reader();
28 | 
29 | 		LispObjRef readToken();
30 | 
31 | 		LispObjRef read_the_rest();
32 | 
33 | 		LispObjRef read_list();
34 | 
35 | 		LispObjRef read();
36 | 
37 | 		LispObjRef operator()();
38 | 
39 | 		std::string  token_;
40 | 
41 | 		TokenType    tokenType_;
42 | 
43 | 	private:
44 | 
45 | 		std::istream& input_;
46 | 
47 | 		std::string  current_line_;
48 | 
49 | 		bool isPeriodNext();
50 | 
51 | 		void nextToken();
52 | 
53 | 		void whitespace();
54 | 
55 | 		std::string readString();
56 | 
57 | 		std::string readChar();
58 | 
59 | 		std::string readNumberOrSymbol(TokenType& type);
60 | 
61 | 		std::string readQuote(TokenType& type);
62 | 
63 | 	};
64 | 
65 | }
66 | #endif
67 | 


--------------------------------------------------------------------------------
/LispString.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <string>
 5 | #include <list>
 6 | #include <vector>
 7 | #include <iostream>
 8 | 
 9 | #include "LispObj.h"
10 | #include "LispString.h"
11 | 
12 | namespace Lisp
13 | {
14 | 	LispObjRef make_string(const char* str)
15 | 	{
16 | 		std::string tempstr(str);
17 | 		return boost::shared_ptr<LispObj>(new LispObj(tempstr));
18 | 	}
19 | 	
20 | 	bool is_string(LispObjRef obj) 
21 | 	{
22 | 		return (obj->which() == STRING);
23 | 	}
24 | }
25 | 
26 | 


--------------------------------------------------------------------------------
/LispString.h:
--------------------------------------------------------------------------------
 1 | #if !defined(H_LISPSTRING)
 2 | #define H_LISPSTRING
 3 | 
 4 | namespace Lisp
 5 | {
 6 | 	LispObjRef make_string(const char* string);
 7 | 	bool       is_string(LispObjRef obj);
 8 | }
 9 | 
10 | #endif
11 | 


--------------------------------------------------------------------------------
/LispSymbol.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <cassert>
 3 | 
 4 | #include <string>
 5 | #include <list>
 6 | #include <vector>
 7 | #include <ios>
 8 | #include <iostream>
 9 | #include <sstream>
10 | 
11 | #include "LispObj.h"
12 | #include "LispNil.h"
13 | #include "LispSymbol.h"
14 | 
15 | namespace Lisp {
16 | 
17 | LispObjRef make_symbol(const char* string) 
18 | {
19 | 	std::string tempstr(string);
20 | 	LispSymbol sym(tempstr, nil);
21 | 	return boost::shared_ptr<LispObj>(new LispObj(SymbolType(sym)));
22 | }
23 | 
24 | 
25 | LispObjRef set_symbol_val(LispObjRef sym, LispObjRef rhs)
26 | {
27 | 	SymbolType& symref = boost::get<SymbolType>(*sym);
28 | 	static_cast<LispSymbol>(symref).value = rhs;
29 | 	return static_cast<LispSymbol>(symref).value;
30 | }
31 | 
32 | LispObjRef get_symbol_value(LispObjRef sym)
33 | {
34 | 	assert(is_symbol(sym));
35 | 	return get_ctype<SymbolType>(sym).value;
36 | }
37 | 
38 | 
39 | bool is_symbol(LispObjRef obj) 
40 | {
41 | 	return (obj->which() == SYMBOL);
42 | }
43 | 
44 | bool is_quote_symbol(LispObjRef obj)
45 | {
46 | 	return ((is_symbol(obj)) && (get_ctype<SymbolType>(obj).name == "QUOTE"));
47 | }
48 | 
49 | } // namespace Lisp
50 | 


--------------------------------------------------------------------------------
/LispSymbol.h:
--------------------------------------------------------------------------------
 1 | #if !defined(LISP_SYMBOL_H_INCLUDED)
 2 | #define LISP_SYMBOL_H_INCLUDED
 3 | 
 4 | 
 5 | namespace Lisp
 6 | {
 7 | 	LispObjRef make_symbol(const char* symbol);
 8 | 	LispObjRef get_symbol_value(LispObjRef sym);
 9 | 	bool       is_symbol(LispObjRef obj);
10 | 	bool is_quote_symbol(LispObjRef obj);
11 | }
12 | 
13 | #endif
14 | 


--------------------------------------------------------------------------------
/Main.cpp:
--------------------------------------------------------------------------------
 1 | 
 2 | #include <boost/log/trivial.hpp>
 3 | #include <boost/log/utility/setup/file.hpp>
 4 | 
 5 | #include <string>
 6 | #include <vector>
 7 | #include <list>
 8 | #include <fstream>
 9 | #include <iostream>
10 | #include <fstream>
11 | #include <cassert>
12 | 
13 | #include "LispObj.h"
14 | #include "LispNil.h"
15 | #include "LispCons.h"
16 | #include "LispReader.h"
17 | #include "LispEval.h"
18 | #include "LispPrinter.h"
19 | 
20 | using namespace Lisp;
21 | 
22 | namespace Lisp
23 | {
24 | Lisp::Eval eval;
25 | }
26 | 
27 | 
28 | // exists to be invoked from gdb for debugging purposes
29 | void trace(LispObjRef obj)
30 | {
31 | 	BOOST_LOG_TRIVIAL(trace) << "--";
32 | 	switch(obj->which())
33 | 	{
34 | 		case NIL:
35 | 			BOOST_LOG_TRIVIAL(trace) << " NIL";
36 | 			break;
37 | 		case	CHAR:
38 | 			BOOST_LOG_TRIVIAL(trace) << " char=" << get_ctype<CharType>(obj);
39 | 			break;
40 | 		case	FIXNUM:
41 | 			BOOST_LOG_TRIVIAL(trace) << " fixnum=" << get_ctype<FixnumType>(obj);
42 | 			break;
43 | 		case	FLOATNUM:
44 | 			BOOST_LOG_TRIVIAL(trace) << " floatnum=" << get_ctype<FloatnumType>(obj);
45 | 			break;
46 | 		case	SYMBOL:
47 | 			BOOST_LOG_TRIVIAL(trace) << " sym=" << get_ctype<SymbolType>(obj).name;
48 | 			break;
49 | 		case	STRING:
50 | 			BOOST_LOG_TRIVIAL(trace) << " char=" << get_ctype<StringType>(obj);
51 | 			break;
52 | 		case	CONS:
53 | 			BOOST_LOG_TRIVIAL(trace) << " car="; trace(car(obj));
54 | 			BOOST_LOG_TRIVIAL(trace) << " cdr="; trace(cdr(obj));
55 | 			break;
56 | 		case	PRIM:
57 | 			BOOST_LOG_TRIVIAL(trace) << " prim() ";
58 | 			break;
59 | 		case	LAMBDA:
60 | 			BOOST_LOG_TRIVIAL(trace) << " lambda() ";
61 | 			BOOST_LOG_TRIVIAL(trace) << " == args() == ";
62 | 			trace(get_ctype<LambdaType>(obj).args);
63 | 			BOOST_LOG_TRIVIAL(trace) << " == body() == ";			
64 | 			trace(get_ctype<LambdaType>(obj).body);				  
65 | 			break;			
66 | 	}
67 | 	BOOST_LOG_TRIVIAL(trace) << "--";
68 | }
69 | 
70 | int main(int argc, char** argv)
71 | {
72 | 	std::ifstream instream;
73 | 
74 | 	if (argc > 1) {
75 | 		instream.open(argv[1], std::ifstream::in);
76 | 	}
77 | 
78 | 	std::ofstream outstream;
79 | 	if (argc > 2) {
80 | 		outstream.open(argv[2], std::ofstream::out); 
81 | 	}
82 | 		
83 | 	Lisp::Reader  read(instream.is_open() ? instream : std::cin);
84 | 	Lisp::Printer print(outstream.is_open() ? outstream : std::cout);
85 | 
86 | 	// REPL
87 | 	while ((!instream.is_open()) || (instream.is_open() && (instream.good()))) {
88 | 		LispObjRef obj = read();
89 | 		printf("Read as :");
90 | 		print(obj);
91 | 		LispObjRef eobj = eval(obj, LispEnv::globalEnv);
92 | 		printf("Result is :");		
93 | 		print(eobj);				
94 | 	}
95 | 	exit(0);
96 | }
97 | 


--------------------------------------------------------------------------------
/Scanner.h:
--------------------------------------------------------------------------------
 1 | #ifndef SCANNER_H_INCLUDED
 2 | #define SCANNER_H_INCLUDED
 3 | 
 4 | class Scanner
 5 | {
 6 | 	public:
 7 | 		
 8 | 		enum eSymbolType
 9 | 		{
10 | 			eBrace = 0,
11 | 			eString,
12 | 			eNumber,
13 | 			eSymbol,
14 | 			eSpecial,
15 | 			eSpace,
16 | 			eEndOfFile
17 | 		};
18 | 		
19 | 		
20 | 		enum eScannerState
21 | 		{
22 | 			eInWhiteSpace = 0,
23 | 			eInString,
24 | 			eInNumeric,
25 | 			eInSymbol,
26 | 			eInOpenBrace,
27 | 			eInCloseBrace,
28 | 			eFinished
29 | 		};
30 | 
31 | 		Scanner(std::istream& in);
32 | 		
33 | 		std::string next(eSymbolType& kind);
34 | 
35 | 
36 | 		
37 | 	private:
38 | 		bool isSpecial(std::string symbol);
39 | 		
40 | 		static const char *specials[];
41 | 		
42 | 		std::istream& in_;
43 | 		eScannerState state_;
44 | };
45 | 
46 | #endif
47 | 


--------------------------------------------------------------------------------
/TODO.org:
--------------------------------------------------------------------------------
 1 | 
 2 | * Reader
 3 | ** DONE Distinguish beteween floats and ints
 4 | ** DONE Handle escaped quotes in strings
 5 | ** DONE Handle chars
 6 | 
 7 | ** DONE Handle dotted lists
 8 | 
 9 | * Types
10 | ** DONE Make s32 fixnum type
11 | ** DONE Add symbol type
12 | 
13 | ** TODO Use LispWeakRef for weak_ptr
14 | ** TODO Lisp Prim == std::function?
15 | 	
16 | * Evaluation
17 | ** DONE Create eval skel
18 | ** DONE Eval ints
19 | ** DONE Eval strings
20 | ** DONE Eval quote
21 | *** DONE Add quote symbol main env
22 | *** DONE Process quote in reader
23 | *** DONE Process quote in eval
24 | **** Implemented quote as a function
25 | ** DONE Eval symbol get
26 | ** DONE Eval symbol set
27 | ** DONE Eval if form
28 | ** DONE Eval primitive procedures
29 | ** TODO Eval lambda form
30 | *** Basically just cons
31 | ** TODO Eval PROG
32 | ** TODO Type Predicates
33 | ** TODO Arith primitives
34 | ** TODO Boolean primitives
35 | ** TODO Type conversions
36 | ** TODO List manipulation
37 | ** TODO Equality testing
38 | ** TODO Bitwise stuff
39 | ** TODO Eval
40 | ** TODO Load
41 | ** TODO Map
42 | 
43 | * Bugs
44 | ** DONE Crash evaluating simple list
45 | ** DONE Lists don't get echoed
46 | ** TODO Dump environment in gdb
47 | ** TODO ((Lambda x (x x) (body)) args..) does not work because we don't know how to eval a cons
48 | ** TODO is_primitive() does not work because we do not identify them
49 | ** TODO are primitives local or global -- global I would have thought
50 | ** TODO but then..local function definitions?
51 | 


--------------------------------------------------------------------------------
/test.in:
--------------------------------------------------------------------------------
 1 | 'QUOTED
 2 | '(1 1.2 (2 4) 63)
 3 | ((LAMBDA (X) X) 2)
 4 | (FN SEL2 (LAMBDA (X Y) Y))
 5 | (SEL2 1 3)
 6 | 1234
 7 | #32
 8 | #\L
 9 | NIL
10 | ()
11 | ASYMBOL
12 | (DEFINE AVARIABLE NIL)
13 | (SET! AVARIABLE 35)
14 | AVARIABLE
15 | (IF NIL 'TRUE 'FALSE)
16 | (IF 1   'TRUE 'FALSE)
17 | 


--------------------------------------------------------------------------------