├── README.md
├── UNLICENSE
├── lisp90.cpp
└── makefile


/README.md:
--------------------------------------------------------------------------------
1 | # Lisp90
2 | 
3 | Code from my 2010 blog post: <http://howtowriteaprogram.blogspot.com/2010/11/lisp-interpreter-in-90-lines-of-c.html>
4 | 


--------------------------------------------------------------------------------
/UNLICENSE:
--------------------------------------------------------------------------------
 1 | This is free and unencumbered software released into the public domain.
 2 | 
 3 | Anyone is free to copy, modify, publish, use, compile, sell, or
 4 | distribute this software, either in source code form or as a compiled
 5 | binary, for any purpose, commercial or non-commercial, and by any
 6 | means.
 7 | 
 8 | In jurisdictions that recognize copyright laws, the author or authors
 9 | of this software dedicate any and all copyright interest in the
10 | software to the public domain. We make this dedication for the benefit
11 | of the public at large and to the detriment of our heirs and
12 | successors. We intend this dedication to be an overt act of
13 | relinquishment in perpetuity of all present and future rights to this
14 | software under copyright law.
15 | 
16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
22 | OTHER DEALINGS IN THE SOFTWARE.
23 | 
24 | For more information, please refer to <http://unlicense.org/>
25 | 


--------------------------------------------------------------------------------
/lisp90.cpp:
--------------------------------------------------------------------------------
  1 | // Scheme Interpreter in 90 lines of C++ (not counting lines after the first 90).
  2 | // Inspired by Peter Norvig's Lis.py.
  3 | 
  4 | // Made by Anthony C. Hay in 2010. See http://howtowriteaprogram.blogspot.co.uk/
  5 | // This is free and unencumbered public domain software, see http://unlicense.org/
  6 | // This code is known to have faults. E.g. it leaks memory. Use at your own risk.
  7 | 
  8 | #include <iostream>
  9 | #include <sstream>
 10 | #include <string>
 11 | #include <vector>
 12 | #include <list>
 13 | #include <map>
 14 | 
 15 | // return given mumber as a string
 16 | std::string str(long n) { std::ostringstream os; os << n; return os.str(); }
 17 | 
 18 | // return true iff given character is '0'..'9'
 19 | bool isdig(char c) { return isdigit(static_cast<unsigned char>(c)) != 0; }
 20 | 
 21 | 
 22 | ////////////////////// cell
 23 | 
 24 | enum cell_type { Symbol, Number, List, Proc, Lambda };
 25 | 
 26 | struct environment; // forward declaration; cell and environment reference each other
 27 | 
 28 | // a variant that can hold any kind of lisp value
 29 | struct cell {
 30 |     typedef cell (*proc_type)(const std::vector<cell> &);
 31 |     typedef std::vector<cell>::const_iterator iter;
 32 |     typedef std::map<std::string, cell> map;
 33 |     cell_type type; std::string val; std::vector<cell> list; proc_type proc; environment * env;
 34 |     cell(cell_type type = Symbol) : type(type), env(0) {}
 35 |     cell(cell_type type, const std::string & val) : type(type), val(val), env(0) {}
 36 |     cell(proc_type proc) : type(Proc), proc(proc), env(0) {}
 37 | };
 38 | 
 39 | typedef std::vector<cell> cells;
 40 | typedef cells::const_iterator cellit;
 41 | 
 42 | const cell false_sym(Symbol, "#f");
 43 | const cell true_sym(Symbol, "#t"); // anything that isn't false_sym is true
 44 | const cell nil(Symbol, "nil");
 45 | 
 46 | 
 47 | ////////////////////// environment
 48 | 
 49 | // a dictionary that (a) associates symbols with cells, and
 50 | // (b) can chain to an "outer" dictionary
 51 | struct environment {
 52 |     environment(environment * outer = 0) : outer_(outer) {}
 53 | 
 54 |     environment(const cells & parms, const cells & args, environment * outer)
 55 |     : outer_(outer)
 56 |     {
 57 |         cellit a = args.begin();
 58 |         for (cellit p = parms.begin(); p != parms.end(); ++p)
 59 |             env_[p->val] = *a++;
 60 |     }
 61 | 
 62 |     // map a variable name onto a cell
 63 |     typedef std::map<std::string, cell> map;
 64 | 
 65 |     // return a reference to the innermost environment where 'var' appears
 66 |     map & find(const std::string & var)
 67 |     {
 68 |         if (env_.find(var) != env_.end())
 69 |             return env_; // the symbol exists in this environment
 70 |         if (outer_)
 71 |             return outer_->find(var); // attempt to find the symbol in some "outer" env
 72 |         std::cout << "unbound symbol '" << var << "'\n";
 73 |         exit(1);
 74 |     }
 75 | 
 76 |     // return a reference to the cell associated with the given symbol 'var'
 77 |     cell & operator[] (const std::string & var)
 78 |     {
 79 |         return env_[var];
 80 |     }
 81 |     
 82 | private:
 83 |     map env_; // inner symbol->cell mapping
 84 |     environment * outer_; // next adjacent outer env, or 0 if there are no further environments
 85 | };
 86 | 
 87 | 
 88 | ////////////////////// built-in primitive procedures
 89 | 
 90 | cell proc_add(const cells & c)
 91 | {
 92 |     long n(atol(c[0].val.c_str()));
 93 |     for (cellit i = c.begin()+1; i != c.end(); ++i) n += atol(i->val.c_str());
 94 |     return cell(Number, str(n));
 95 | }
 96 | 
 97 | cell proc_sub(const cells & c)
 98 | {
 99 |     long n(atol(c[0].val.c_str()));
100 |     for (cellit i = c.begin()+1; i != c.end(); ++i) n -= atol(i->val.c_str());
101 |     return cell(Number, str(n));
102 | }
103 | 
104 | cell proc_mul(const cells & c)
105 | {
106 |     long n(1);
107 |     for (cellit i = c.begin(); i != c.end(); ++i) n *= atol(i->val.c_str());
108 |     return cell(Number, str(n));
109 | }
110 | 
111 | cell proc_div(const cells & c)
112 | {
113 |     long n(atol(c[0].val.c_str()));
114 |     for (cellit i = c.begin()+1; i != c.end(); ++i) n /= atol(i->val.c_str());
115 |     return cell(Number, str(n));
116 | }
117 | 
118 | cell proc_greater(const cells & c)
119 | {
120 |     long n(atol(c[0].val.c_str()));
121 |     for (cellit i = c.begin()+1; i != c.end(); ++i)
122 |         if (n <= atol(i->val.c_str()))
123 |             return false_sym;
124 |     return true_sym;
125 | }
126 | 
127 | cell proc_less(const cells & c)
128 | {
129 |     long n(atol(c[0].val.c_str()));
130 |     for (cellit i = c.begin()+1; i != c.end(); ++i)
131 |         if (n >= atol(i->val.c_str()))
132 |             return false_sym;
133 |     return true_sym;
134 | }
135 | 
136 | cell proc_less_equal(const cells & c)
137 | {
138 |     long n(atol(c[0].val.c_str()));
139 |     for (cellit i = c.begin()+1; i != c.end(); ++i)
140 |         if (n > atol(i->val.c_str()))
141 |             return false_sym;
142 |     return true_sym;
143 | }
144 | 
145 | cell proc_length(const cells & c) { return cell(Number, str(c[0].list.size())); }
146 | cell proc_nullp(const cells & c)  { return c[0].list.empty() ? true_sym : false_sym; }
147 | cell proc_car(const cells & c)    { return c[0].list[0]; }
148 | 
149 | cell proc_cdr(const cells & c)
150 | {
151 |     if (c[0].list.size() < 2)
152 |         return nil;
153 |     cell result(c[0]);
154 |     result.list.erase(result.list.begin());
155 |     return result;
156 | }
157 | 
158 | cell proc_append(const cells & c)
159 | {
160 |     cell result(List);
161 |     result.list = c[0].list;
162 |     for (cellit i = c[1].list.begin(); i != c[1].list.end(); ++i) result.list.push_back(*i);
163 |     return result;
164 | }
165 | 
166 | cell proc_cons(const cells & c)
167 | {
168 |     cell result(List);
169 |     result.list.push_back(c[0]);
170 |     for (cellit i = c[1].list.begin(); i != c[1].list.end(); ++i) result.list.push_back(*i);
171 |     return result;
172 | }
173 | 
174 | cell proc_list(const cells & c)
175 | {
176 |     cell result(List); result.list = c;
177 |     return result;
178 | }
179 | 
180 | // define the bare minimum set of primintives necessary to pass the unit tests
181 | void add_globals(environment & env)
182 | {
183 |     env["nil"] = nil;   env["#f"] = false_sym;  env["#t"] = true_sym;
184 |     env["append"] = cell(&proc_append);   env["car"]  = cell(&proc_car);
185 |     env["cdr"]    = cell(&proc_cdr);      env["cons"] = cell(&proc_cons);
186 |     env["length"] = cell(&proc_length);   env["list"] = cell(&proc_list);
187 |     env["null?"]  = cell(&proc_nullp);    env["+"]    = cell(&proc_add);
188 |     env["-"]      = cell(&proc_sub);      env["*"]    = cell(&proc_mul);
189 |     env["/"]      = cell(&proc_div);      env[">"]    = cell(&proc_greater);
190 |     env["<"]      = cell(&proc_less);     env["<="]   = cell(&proc_less_equal);
191 | }
192 | 
193 | 
194 | ////////////////////// eval
195 | 
196 | cell eval(cell x, environment * env)
197 | {
198 |     if (x.type == Symbol)
199 |         return env->find(x.val)[x.val];
200 |     if (x.type == Number)
201 |         return x;
202 |     if (x.list.empty())
203 |         return nil;
204 |     if (x.list[0].type == Symbol) {
205 |         if (x.list[0].val == "quote")       // (quote exp)
206 |             return x.list[1];
207 |         if (x.list[0].val == "if")          // (if test conseq [alt])
208 |             return eval(eval(x.list[1], env).val == "#f" ? (x.list.size() < 4 ? nil : x.list[3]) : x.list[2], env);
209 |         if (x.list[0].val == "set!")        // (set! var exp)
210 |             return env->find(x.list[1].val)[x.list[1].val] = eval(x.list[2], env);
211 |         if (x.list[0].val == "define")      // (define var exp)
212 |             return (*env)[x.list[1].val] = eval(x.list[2], env);
213 |         if (x.list[0].val == "lambda") {    // (lambda (var*) exp)
214 |             x.type = Lambda;
215 |             // keep a reference to the environment that exists now (when the
216 |             // lambda is being defined) because that's the outer environment
217 |             // we'll need to use when the lambda is executed
218 |             x.env = env;
219 |             return x;
220 |         }
221 |         if (x.list[0].val == "begin") {     // (begin exp*)
222 |             for (size_t i = 1; i < x.list.size() - 1; ++i)
223 |                 eval(x.list[i], env);
224 |             return eval(x.list[x.list.size() - 1], env);
225 |         }
226 |     }
227 |                                             // (proc exp*)
228 |     cell proc(eval(x.list[0], env));
229 |     cells exps;
230 |     for (cell::iter exp = x.list.begin() + 1; exp != x.list.end(); ++exp)
231 |         exps.push_back(eval(*exp, env));
232 |     if (proc.type == Lambda) {
233 |         // Create an environment for the execution of this lambda function
234 |         // where the outer environment is the one that existed* at the time
235 |         // the lambda was defined and the new inner associations are the
236 |         // parameter names with the given arguments.
237 |         // *Although the environmet existed at the time the lambda was defined
238 |         // it wasn't necessarily complete - it may have subsequently had
239 |         // more symbols defined in that environment.
240 |         return eval(/*body*/proc.list[2], new environment(/*parms*/proc.list[1].list, /*args*/exps, proc.env));
241 |     }
242 |     else if (proc.type == Proc)
243 |         return proc.proc(exps);
244 | 
245 |     std::cout << "not a function\n";
246 |     exit(1);
247 | }
248 | 
249 | 
250 | ////////////////////// parse, read and user interaction
251 | 
252 | // convert given string to list of tokens
253 | std::list<std::string> tokenize(const std::string & str)
254 | {
255 |     std::list<std::string> tokens;
256 |     const char * s = str.c_str();
257 |     while (*s) {
258 |         while (*s == ' ')
259 |             ++s;
260 |         if (*s == '(' || *s == ')')
261 |             tokens.push_back(*s++ == '(' ? "(" : ")");
262 |         else {
263 |             const char * t = s;
264 |             while (*t && *t != ' ' && *t != '(' && *t != ')')
265 |                 ++t;
266 |             tokens.push_back(std::string(s, t));
267 |             s = t;
268 |         }
269 |     }
270 |     return tokens;
271 | }
272 | 
273 | // numbers become Numbers; every other token is a Symbol
274 | cell atom(const std::string & token)
275 | {
276 |     if (isdig(token[0]) || (token[0] == '-' && isdig(token[1])))
277 |         return cell(Number, token);
278 |     return cell(Symbol, token);
279 | }
280 | 
281 | // return the Lisp expression in the given tokens
282 | cell read_from(std::list<std::string> & tokens)
283 | {
284 |     const std::string token(tokens.front());
285 |     tokens.pop_front();
286 |     if (token == "(") {
287 |         cell c(List);
288 |         while (tokens.front() != ")")
289 |             c.list.push_back(read_from(tokens));
290 |         tokens.pop_front();
291 |         return c;
292 |     }
293 |     else
294 |         return atom(token);
295 | }
296 | 
297 | // return the Lisp expression represented by the given string
298 | cell read(const std::string & s)
299 | {
300 |     std::list<std::string> tokens(tokenize(s));
301 |     return read_from(tokens);
302 | }
303 | 
304 | // convert given cell to a Lisp-readable string
305 | std::string to_string(const cell & exp)
306 | {
307 |     if (exp.type == List) {
308 |         std::string s("(");
309 |         for (cell::iter e = exp.list.begin(); e != exp.list.end(); ++e)
310 |             s += to_string(*e) + ' ';
311 |         if (s[s.size() - 1] == ' ')
312 |             s.erase(s.size() - 1);
313 |         return s + ')';
314 |     }
315 |     else if (exp.type == Lambda)
316 |         return "<Lambda>";
317 |     else if (exp.type == Proc)
318 |         return "<Proc>";
319 |     return exp.val;
320 | }
321 | 
322 | // the default read-eval-print-loop
323 | void repl(const std::string & prompt, environment * env)
324 | {
325 |     for (;;) {
326 |         std::cout << prompt;
327 |         std::string line; std::getline(std::cin, line);
328 |         std::cout << to_string(eval(read(line), env)) << '\n';
329 |     }
330 | }
331 | 
332 | 
333 | #ifdef LISP90_TEST
334 | 
335 | ////////////////////// unit tests
336 | 
337 | unsigned g_test_count;      // count of number of unit tests executed
338 | unsigned g_fault_count;     // count of number of unit tests that fail
339 | 
340 | template <typename T1, typename T2>
341 | void test_equal_(const T1 & value, const T2 & expected_value, const char * file, int line)
342 | {
343 |     ++g_test_count;
344 |     if (value != expected_value) {
345 |         std::cout
346 |             << file << '(' << line << ") : "
347 |             << " expected " << expected_value
348 |             << ", got " << value
349 |             << '\n';
350 |         ++g_fault_count;
351 |     }
352 | }
353 | 
354 | // write a message to std::cout if value != expected_value
355 | #define TEST_EQUAL(value, expected_value) test_equal_(value, expected_value, __FILE__, __LINE__)
356 | 
357 | // evaluate the given Lisp expression and compare the result against the given expected_result
358 | #define TEST(expr, expected_result) TEST_EQUAL(to_string(eval(read(expr), &global_env)), expected_result)
359 | 
360 | 
361 | int main ()
362 | {
363 |     environment global_env; add_globals(global_env);
364 | 
365 |     // the 29 unit tests for lis.py
366 |     TEST("(quote (testing 1 (2.0) -3.14e159))", "(testing 1 (2.0) -3.14e159)");
367 |     TEST("(+ 2 2)", "4");
368 |     TEST("(+ (* 2 100) (* 1 10))", "210");
369 |     TEST("(if (> 6 5) (+ 1 1) (+ 2 2))", "2");
370 |     TEST("(if (< 6 5) (+ 1 1) (+ 2 2))", "4");
371 |     TEST("(define x 3)", "3");
372 |     TEST("x", "3");
373 |     TEST("(+ x x)", "6");
374 |     TEST("(begin (define x 1) (set! x (+ x 1)) (+ x 1))", "3");
375 |     TEST("((lambda (x) (+ x x)) 5)", "10");
376 |     TEST("(define twice (lambda (x) (* 2 x)))", "<Lambda>");
377 |     TEST("(twice 5)", "10");
378 |     TEST("(define compose (lambda (f g) (lambda (x) (f (g x)))))", "<Lambda>");
379 |     TEST("((compose list twice) 5)", "(10)");
380 |     TEST("(define repeat (lambda (f) (compose f f)))", "<Lambda>");
381 |     TEST("((repeat twice) 5)", "20");
382 |     TEST("((repeat (repeat twice)) 5)", "80");
383 |     TEST("(define fact (lambda (n) (if (<= n 1) 1 (* n (fact (- n 1))))))", "<Lambda>");
384 |     TEST("(fact 3)", "6");
385 |     //TEST("(fact 50)", "30414093201713378043612608166064768844377641568960512000000000000");
386 |     TEST("(fact 12)", "479001600"); // no bignums; this is as far as we go with 32 bits
387 |     TEST("(define abs (lambda (n) ((if (> n 0) + -) 0 n)))", "<Lambda>");
388 |     TEST("(list (abs -3) (abs 0) (abs 3))", "(3 0 3)");
389 |     TEST("(define combine (lambda (f)"
390 |              "(lambda (x y)"
391 |                 "(if (null? x) (quote ())"
392 |                 "(f (list (car x) (car y))"
393 |                 "((combine f) (cdr x) (cdr y)))))))", "<Lambda>");
394 |     TEST("(define zip (combine cons))", "<Lambda>");
395 |     TEST("(zip (list 1 2 3 4) (list 5 6 7 8))", "((1 5) (2 6) (3 7) (4 8))");
396 |     TEST("(define riff-shuffle (lambda (deck) (begin"
397 |             "(define take (lambda (n seq) (if (<= n 0) (quote ()) (cons (car seq) (take (- n 1) (cdr seq))))))"
398 |             "(define drop (lambda (n seq) (if (<= n 0) seq (drop (- n 1) (cdr seq)))))"
399 |             "(define mid (lambda (seq) (/ (length seq) 2)))"
400 |             "((combine append) (take (mid deck) deck) (drop (mid deck) deck)))))", "<Lambda>");
401 |     TEST("(riff-shuffle (list 1 2 3 4 5 6 7 8))", "(1 5 2 6 3 7 4 8)");
402 |     TEST("((repeat riff-shuffle) (list 1 2 3 4 5 6 7 8))",  "(1 3 5 7 2 4 6 8)");
403 |     TEST("(riff-shuffle (riff-shuffle (riff-shuffle (list 1 2 3 4 5 6 7 8))))", "(1 2 3 4 5 6 7 8)");
404 | 
405 |     std::cout
406 |         << "total tests " << g_test_count
407 |         << ", total failures " << g_fault_count
408 |         << "\n";
409 |     return g_fault_count ? EXIT_FAILURE : EXIT_SUCCESS;
410 | }
411 | 
412 | #else
413 | 
414 | int main ()
415 | {
416 |     environment global_env; add_globals(global_env);
417 |     repl("90> ", &global_env);
418 | }
419 | 
420 | #endif
421 | 


--------------------------------------------------------------------------------
/makefile:
--------------------------------------------------------------------------------
 1 | # makefile for Lisp90
 2 | # see http://howtowriteaprogram.blogspot.com/2010/11/lisp-interpreter-in-90-lines-of-c.html
 3 | 
 4 | TARGET = lisp90
 5 | TEST_TARGET = lisp90test
 6 | LIBS = 
 7 | CC = clang++
 8 | CFLAGS = -std=c++11 -stdlib=libc++ -Wall
 9 | SRC_DIR  = .
10 | TEST_DIR = .
11 | INCLUDES = -I$(SRC_DIR)
12 | 
13 | 
14 | 
15 | all: $(TARGET)
16 | 
17 | test: $(TEST_TARGET)
18 | 	./$(TEST_TARGET)
19 | 
20 | clean:
21 | 	rm -f $(TARGET)
22 | 	rm -f $(TEST_TARGET)
23 | 
24 | 
25 | $(TARGET): $(TEST_DIR)/lisp90.cpp
26 | 	$(CC) $(CFLAGS) $(INCLUDES) $< -o $@
27 | 
28 | $(TEST_TARGET): $(TEST_DIR)/lisp90.cpp
29 | 	$(CC) $(CFLAGS) -DLISP90_TEST $(INCLUDES) $< -o $@
30 | 
31 | 
32 | 


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