Skip to content

Instantly share code, notes, and snippets.

Created August 15, 2012 02:13
  • Star 11 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
Chapter 1 from Lisp in Small Pieces
(ns lisp-ch1)
(def self-evaluating?
(some-fn number? string? char?
true? false? vector?))
(defn -atom? [s]
(or (self-evaluating? s)
(symbol? s)))
(defn -wrong [& msg]
(throw (RuntimeException. (apply str msg))))
(defn -eprogn [[head & tail] env]
(if tail
(do (evaluate head env)
(recur tail env))
(evaluate head env)))
(defn -extend [env names values]
(let [bindings @env]
(if (symbol? names)
(assoc bindings names values)
(if (= (count names) (count values))
(merge bindings (zipmap names values))
(-wrong "Too few values"))))))
(defn -make-function [params body env]
(fn [values]
(-eprogn body (-extend env params values))))
(defn -invoke [f args]
(if (fn? f)
(f args)
(-wrong "Not a function " f)))
(defn evaluate
[expr env]
(if (-atom? expr)
(cond (symbol? expr) (expr @env)
(self-evaluating? expr) expr
:else (-wrong "Cannot evaluate " expr))
(let [[head & [second third fourth :as tail]] expr]
(condp = head
'quote second
'if (if (evaluate second env)
(evaluate third env)
(evaluate fourth env))
'begin (-eprogn tail env)
'set! (let [value (evaluate third env)]
(swap! env assoc second value)
'lambda (-make-function second (rest tail) env)
(-invoke (evaluate head env)
(map #(evaluate % env) tail))))))
(evaluate 'a (atom '{a 42}))
(evaluate '(quote a) (atom '{a 42}))
(evaluate '(begin (quote a) (quote b))
(atom '{a 42}))
(evaluate 42 (atom '{a 42}))
(evaluate true (atom '{a 42}))
(evaluate '(set! b 36) (atom '{a 42}))
(evaluate '(begin (set! b a) (set! a 108))
(atom '{a 42}))
(defmacro bind [env name value]
`(assoc ~env (quote ~name) ~value))
(defmacro primitive [env name f arity]
`(bind ~env ~name
(fn [values#]
(let [len# (count values#)]
(if (= ~arity len#)
(apply ~f values#)
(-wrong "Wrong number of args passed to "
", expected "
", got "
(defmacro predicate [env name f arity]
`(primitive ~env ~name
(fn [values#]
(or (apply ~f values#)
(defmacro defenv [& decls]
(-> {}
(def globals
(bind |f| nil)
(bind |t| true)
(primitive cons cons 2)
(primitive car first 1)
(primitive cdr rest 1)
(primitive + + 2)
(primitive - - 2)
(primitive remainder rem 2)
(primitive quotient quot 2)
(primitive display #(print %) 1)
(primitive newline #(println) 0)
(predicate <= <= 2)
(predicate >= >= 2)
(predicate = = 2)
(predicate > > 2)
(predicate < < 2)
(primitive * * 2)
(predicate symbol? symbol? 1)
(predicate eq? = 2)))
(evaluate '|t| globals)
(evaluate '|f| globals)
(evaluate '(+ 1 2) globals)
(evaluate '(car (quote (1 2))) globals)
(evaluate '(cdr (quote (1 2))) globals)
(evaluate '(cons 0 (quote (1 2))) globals)
(evaluate '(begin (set! pi 3.14) pi) globals)
(evaluate '(begin (set! make-adder
(lambda (n)
(lambda (x)
(+ x n))))
(set! add100 (make-adder 100))
(add100 42))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment