--- /dev/null
+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)
+
+
projects / mylisp.git / commitdiff