From a158a647f2f6a7e342b72a5aed3b6a0810d2898b Mon Sep 17 00:00:00 2001
From: Jorge Gorbe <slack@codemaniacs.com>
Date: Thu, 9 Jan 2014 21:02:03 +0100
Subject: [PATCH] initial version

---
 fib.l     |  19 +++
 lisp0.py  | 463 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 prelude.l |  28 ++++
 repl.py   |  16 ++
 4 files changed, 526 insertions(+)
 create mode 100644 fib.l
 create mode 100644 lisp0.py
 create mode 100644 prelude.l
 create mode 100644 repl.py

diff --git a/fib.l b/fib.l
new file mode 100644
index 0000000..ea091e8
--- /dev/null
+++ b/fib.l
@@ -0,0 +1,19 @@
+(defun fib_aux (i n a1 a2)
+    (cond
+        ((= n 1) 1)
+        ((= n 2) 1)
+        ((= i n) a2)
+        ('#t     (fib_aux (+ i 1) n a2 (+ a1 a2)))))
+
+(defun fib (i)
+    (fib_aux 2 i 1 1))
+
+(display (fib 1))
+(display (fib 2))
+(display (fib 3))
+(display (fib 4))
+(display (fib 5))
+(display (fib 6))
+(display (fib 7))
+(display (fib 1000))
+
diff --git a/lisp0.py b/lisp0.py
new file mode 100644
index 0000000..3e58444
--- /dev/null
+++ b/lisp0.py
@@ -0,0 +1,463 @@
+import types
+import sys
+
+class Pair:
+    def __init__(self, car, cdr):
+        self.car = car
+        self.cdr = cdr
+
+class Value:
+    def __init__(self, t, v=None):
+        self.t = t
+        self.v = v
+    
+    def __str__(self):
+        result = "" # self.t+"["
+        if is_pair(self):
+            result += "("
+            l = self
+            while is_pair(cdr(l)):
+                result += "%s " % car(l)
+                l = cdr(l)
+            result += "%s" % car(l)
+            if not is_nil(cdr(l)):
+                result += " . %s" % cdr(l)
+            result += ")"
+        elif is_function(self):
+            result += "(lambda %s %s), environment: %s"%(self.v[0], self.v[1], self.v[2])
+        elif is_macro(self):
+            result += "macro: %s"%str(self.v)
+        elif is_nil(self):
+            result += "nil"
+        elif is_string(self):
+            result += '"' + self.v + '"'
+        else:
+            result += str(self.v)
+
+        #result += "]"
+        return result
+
+Value.TRUE = Value("symbol", "#t")
+Value.FALSE = Value("symbol", "#f")
+Value.NIL = Value("nil", None)
+
+
+# value constructors
+def make_int(i):                      return Value("int", i)
+def make_string(s):                   return Value("string", s)
+def make_function(params, body, env): return Value("function", [params, body, env])
+def make_macro(f):                    return Value("macro", f)
+def make_symbol(s):                   return Value("symbol", s)
+def cons(x,y):                        return Value("pair", Pair(x,y))
+
+def make_list(*args):
+    if len(args) == 0: return Value.NIL
+    result = cons(args[0], Value.NIL)
+    last = result
+    for i in args[1:]:
+        new_last = cons(i, Value.NIL)
+        set_cdr(last, new_last)
+        last = new_last
+    return result
+
+
+# value_accessors
+def car(p):
+    assert(p.t == "pair")
+    return p.v.car
+    
+def cdr(p):
+    assert(p.t == "pair")
+    return p.v.cdr
+
+def cadr(p): return car(cdr(p))
+def cddr(p): return cdr(cdr(p))
+
+def set_car(p, v):
+    assert(p.t == "pair")
+    p.v.car = v
+
+def set_cdr(p, v):
+    assert(p.t == "pair")
+    p.v.cdr = v
+
+
+
+# type predicates for values
+def is_pair(v):     return v.t == "pair"
+def is_function(v): return v.t == "function"
+def is_macro(v):    return v.t == "macro"
+def is_symbol(v):   return v.t == "symbol"
+def is_string(v):   return v.t == "string"
+def is_nil(v):      return v.t == "nil"
+def is_int(v):      return v.t == "int"
+
+
+def is_false(v):    return is_symbol(v) and v.v == "#f"
+def is_true(v):     return not is_false(v)
+
+
+# Environment is a dictionary wrapper with "inheritance": if a key is not found
+# the parent environment is searched, and so on.
+class Environment:
+    def __init__(self, parent=None, dictionary=None):
+        self.p = parent
+        self.d = dictionary or {}
+
+    def __getitem__(self, i):
+        if i in self.d:
+            return self.d[i]
+        else:
+            if self.p is not None:
+                return self.p[i]
+            else:
+                print "value not found for symbol %s"%(i)
+                raise KeyError
+
+    def __setitem__(self, i, v):
+        self.d[i] = v
+
+    def __contains__(self, i):
+        item = self.__getitem__(i)
+        return (item is not None)
+
+    def __str__(self):
+        return "[d="+str(self.d)+", p="+str(self.p)+"]"
+
+
+# helper lisp-list functions
+
+def reverse_list_rec(l, result):
+    if l.t == "nil": return result
+    else: return reverse_list_rec(l.v.cdr, cons(l.v.car, result))
+
+def reverse_list(l):
+    return reverse_list_rec(l, Value.NIL)
+
+def map_list_rec(func, l, result):
+    if l.t == "nil": return result
+    else: return map_list_rec(func, l.v.cdr, cons(func(l.v.car), result))
+
+def map_list(func, l):
+    return reverse_list(map_list_rec(func, l, Value.NIL))
+
+
+def do_list(func, l):
+    if is_nil(l): return
+    else:
+        func(car(l))
+        do_list(func, cdr(l))
+
+def eval_list(args, env):
+    return map_list(lambda x: lisp_eval(x, env), args)
+
+
+# Built-in functions and special forms
+# ------------------------------------
+#
+# Built-in functions sometimes need to access the raw (non-evaluated) args.
+# Therefore, if a python function wants evaluated args, it must call eval_list(args) to get them
+
+def lisp_lambda(args, env):
+    return make_function(car(args), cadr(args), Environment(env))
+
+def lisp_macro(args, env):
+    return make_macro(lisp_lambda(args, env))
+
+def lisp_define(args, env):
+    name = car(args)
+    assert(is_symbol(name))
+    value = cadr(args)
+    env[name.v] = lisp_eval(value, env)
+    return None
+
+
+def lisp_list(args, env):
+    return eval_list(args, env)
+
+def lisp_quote(args, env):
+    assert(is_nil(cdr(args)))
+    return car(args)
+
+def quasiquote_expression(e, env):
+    """returns an expression with unquotes recursively expanded as needed. If
+    called with an unquote-splicing expression, it will return a python list of
+    expressions, which will be inserted into the containing list"""
+    # if e is a list, look for unquotes
+    if is_pair(e):
+        first = car(e)
+        if is_symbol(first) and first.v == "unquote":
+            assert(is_nil(cddr(e)))
+            result = lisp_eval(cadr(e), env)
+        elif is_symbol(first) and first.v == "unquote-splicing":
+            second = lisp_eval(cadr(e), env)
+            assert(is_nil(cddr(e)))
+            assert(is_pair(second))
+            result = []
+            while not is_nil(second):
+                result.append(car(second))
+                second = cdr(second)
+
+        else:
+            result = make_list()
+            cur = e
+            while not is_nil(cur):
+                r = quasiquote_expression(car(cur), env)
+                if type(r) != list:
+                    r = [r]
+                for i in r:
+                    result = cons(i, result)
+                
+                cur = cdr(cur)
+
+            result = reverse_list(result)
+    else:
+        result = e
+    return result
+
+def lisp_quasiquote(args, env):
+    assert(is_nil(cdr(args)))
+    e = car(args)
+    return quasiquote_expression(e, env)
+
+
+def lisp_car(args, env):
+    args = eval_list(args, env)
+    assert(is_nil(cdr(args)))
+    return car(car(args))
+
+def lisp_cdr(args, env):
+    args = eval_list(args, env)
+    assert(is_nil(cdr(args)))
+    return cdr(car(args))
+
+def lisp_cons(args, env):
+    args = eval_list(args, env)
+    assert(is_nil(cddr(args)))
+    return cons(car(args), cadr(args))
+    
+
+def lisp_cond(args, env):
+    while not is_nil(args):
+        c = car(args)
+        assert(is_pair(c))
+        if is_true(lisp_eval(car(c), env)):
+            actions = cdr(c)
+            while not is_nil(actions):
+                result = lisp_eval(car(actions), env)
+                actions = cdr(actions)
+            return result
+        args = cdr(args)
+    return Value.NIL
+
+# defined only for atoms
+def lisp_equal(args, env):
+    args = eval_list(args, env)
+    e1 = car(args)
+    e2 = cadr(args)
+    result = (not is_pair(e1)) and e1.t == e2.t and e1.v == e2.v
+    if result:
+        return Value.TRUE
+    else:
+        return Value.FALSE
+
+
+def plus_rec(args, env, result):
+    if is_nil(args): return result
+    else:
+        result.v += lisp_eval(car(args), env).v
+        return plus_rec(cdr(args), env, result)
+
+def lisp_plus(args, env):
+    return plus_rec(args, env, make_int(0))
+
+
+def lisp_display(args, env):
+    args = eval_list(args, env)
+    do_list(lambda x: sys.stdout.write(str(x)), args)
+    sys.stdout.write("\n")
+    return Value.NIL
+    
+
+# Helper functions for the evaluator
+# ----------------------------------
+
+def is_python_function(x):
+    return type(x) == types.FunctionType
+    
+def should_eval_arguments(x):
+    if is_python_function(x) or is_macro(x):
+        return False
+    elif is_function(x):
+        return True
+    else:
+        print "Expected a function or macro, found %s"%str(x)
+        raise Exception
+
+# Evaluator
+# ---------
+
+global_env = Environment()
+
+
+def lisp_eval(e, env):
+    """evals an expression"""
+    result = e
+    if is_symbol(e):
+        result = env[e.v]
+    elif is_pair(e):
+        f = lisp_eval(car(e), env)
+        args = cdr(e)
+        if should_eval_arguments(f):
+            args = eval_list(args, env)
+        result = lisp_apply(f, args, env)
+    #print "evaluating %s\nresult: %s"%(e, result)
+    return result
+
+def lisp_apply(f, args, env):
+    """applies an argument list to a function or special form"""
+    # special forms and built-in functions are stored in the global environment as python functions
+    if type(f) == types.FunctionType:
+        return f(args, env)
+    elif f.t == "macro":
+        expansion = lisp_apply(f.v, args, env)
+        #print "macro expansion:", expansion
+        result = lisp_eval(expansion, env)
+        return result
+    else:
+        formals, body, environment = f.v
+        new_env = Environment(environment)
+        #insert parameters into the environment
+        while not is_nil(formals):
+            name = car(formals)
+            formals = cdr(formals)
+            if not is_nil(args):
+                arg = car(args)
+                args = cdr(args)
+            else:
+                arg = Value.NIL
+
+            new_env[name.v] = arg
+
+        return lisp_eval(body, new_env)
+
+# lisp_eval accepts a single expression instead of a list of args,
+# this one can be called from lisp
+def lisp_eval_exported(args, env):
+    args = eval_list(args, env)
+    return lisp_eval(car(args), env)
+
+global_env["lambda"]     = lisp_lambda
+global_env["macro"]      = lisp_macro
+global_env["define"]     = lisp_define
+global_env["cons"]       = lisp_cons
+global_env["car"]        = lisp_car
+global_env["cdr"]        = lisp_cdr
+global_env["cond"]       = lisp_cond
+global_env["eval"]       = lisp_eval_exported
+global_env["quote"]      = lisp_quote
+global_env["quasiquote"] = lisp_quasiquote
+global_env["display"]    = lisp_display
+global_env["list"]       = lisp_list
+global_env["="]          = lisp_equal
+global_env["+"]          = lisp_plus
+
+global_env["nil"]        = Value.NIL
+
+
+
+# Simple S-expression parser
+# --------------------------
+
+def parse_list(s):
+    if s[0] != '(':
+        return None
+
+    s = s[1:]
+    result = make_list()
+    while s[0] != ')':
+        expr, s = parse(s)
+        if expr == None:
+            return None
+        result = cons(expr, result)
+
+    return reverse_list(result), s[1:]
+
+def parse_symbol(s):
+    index = 0
+    l = len(s)
+    while index < l:
+        c = s[index]
+        if c.isspace() or c == '(' or c == ')':
+            return make_symbol(s[:index]), s[index:]
+        index = index + 1
+
+    return make_symbol(s), ""
+
+def parse_int(s):
+    index = 0
+    l = len(s)
+    while index < l:
+        if not s[index].isdigit():
+            return make_int(int(s[:index])), s[index:]
+        index = index + 1
+
+    return make_int(int(s)), ""
+
+def parse_string(s):
+    index = 1
+    l = len(s)
+    while index < l:
+        c = s[index]
+        if c == '"':
+            return make_string(s[1:index]), s[index+1:]
+        index = index + 1
+    return None # no ending quote -> parse error
+
+
+
+def parse_quote(s):
+    quoted, s = parse(s[1:])
+    return make_list(make_symbol("quote"), quoted), s
+
+def parse_quasiquote(s):
+    quoted, s = parse(s[1:])
+    return make_list(make_symbol("quasiquote"), quoted), s
+
+def parse_unquote(s):
+    if s[1] == '@':
+        quoted, s = parse(s[2:])
+        return make_list(make_symbol("unquote-splicing"), quoted), s
+    else:
+        quoted, s = parse(s[1:])
+        return make_list(make_symbol("unquote"), quoted), s
+
+
+def parse(s):
+    s = s.lstrip()
+    if s == '':
+        return None,''
+    if s[0] == '(':
+        return parse_list(s)
+    elif s[0] == "'":
+        return parse_quote(s)
+    elif s[0] == "`":
+        return parse_quasiquote(s)
+    elif s[0] == ",":
+        return parse_unquote(s)
+    elif s[0].isdigit():
+        return parse_int(s)
+    elif s[0] == '"':
+        return parse_string(s)
+    else:
+        return parse_symbol(s)
+    
+def eval_file(name):
+    f = file(name)
+    s = f.read()
+    while s != "":
+        e, s = parse(s)
+        if e is not None:
+            lisp_eval(e, global_env)
+
+
diff --git a/prelude.l b/prelude.l
new file mode 100644
index 0000000..ec1b617
--- /dev/null
+++ b/prelude.l
@@ -0,0 +1,28 @@
+(define defmacro (macro (name args body) `(define ,name (macro ,args ,body))))
+
+(defmacro defun (name args body) `( define ,name (lambda ,args ,body )))
+
+(defun cadr (x) (car (cdr x)))
+
+(defun collect_rec (func l result)
+    (cond
+        ((= nil l) result)
+        ('#t (collect_rec func (cdr l) (cons (func (car l)) result)))))
+
+(defun collect (func l) (collect_rec func l nil))
+
+(defmacro let (bindings body)
+    `((lambda ,(collect car bindings) ,body) ,@(collect cadr bindings))
+)
+
+(defmacro if (test then else) `(cond (,test ,then) ('#t ,else)))
+
+
+(defun double (x) (+ x x))
+
+
+
+
+
+
+
diff --git a/repl.py b/repl.py
new file mode 100644
index 0000000..eb06d6c
--- /dev/null
+++ b/repl.py
@@ -0,0 +1,16 @@
+from lisp0 import *
+import sys
+
+eval_file("prelude.l")
+
+if len(sys.argv) > 1:
+    for f in sys.argv[1:]:
+        eval_file(f)
+else:
+    while True:
+        in_str = raw_input()
+        e,s = parse(in_str)
+        result = lisp_eval(e, global_env)
+        print(result)
+
+
-- 
2.34.1