Create a gist now

Instantly share code, notes, and snippets.

[Clojure] SICP 4.1: The Metacircular Evaluator
(ns sicp.ch4-1
(:refer-clojure :exclude [apply eval true? false?]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Evaluator data structures (ch.4.1.3, 4)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; procedure
(defn tagged-list? [exp tag]
(if (seq? exp)
(= (first exp) tag)
false))
(defn primitive-procedure? [proc]
(tagged-list? proc :primitive))
(defn primitive-implementation [proc]
(second proc))
(def primitive-procedures
[(list :car first)
(list :cdr #(if (empty? (rest %)) nil (rest %)))
(list :cons cons)
(list :null? nil?)
(list :+ +)
(list :- -)
(list :* *)
(list :/ /)])
(defn primitive-procedure-names []
(map first primitive-procedures))
(defn primitive-procedure-objects []
(map #(list :primitive (second %)) primitive-procedures))
(def apply-in-underlying-scheme clojure.core/apply)
(defn apply-primitive-procedure [proc args]
(apply-in-underlying-scheme
(primitive-implementation proc) args))
(defn make-procedure [parameters body env]
(list :procedure parameters body env))
(defn compound-procedure? [p]
(tagged-list? p :procedure))
(defn procedure-parameters [p] (nth p 1))
(defn procedure-body [p] (nth p 2))
(defn procedure-environment [p] (nth p 3))
;;; environments
(defn enclosing-environment [env] (rest env))
(defn first-frame [env] (first env))
(def the-empty-environment '())
(defn make-frame [variables values]
(let [atom-values (map atom values)]
(atom (list variables atom-values))))
(defn frame-variables [frame] (first @frame))
(defn frame-values [frame] (first (rest @frame)))
(defn add-binding-to-frame! [var val frame]
(reset! frame (list (cons var (frame-variables frame))
(cons (atom val) (frame-values frame)))))
(defn extend-environment [vars vals base-env]
(if (= (count vars) (count vals))
(cons (make-frame vars vals) base-env)
(throw (RuntimeException. (str "Inconsistent length")))))
(defn lookup-variable-value [var env]
(letfn [(env-loop [env]
(letfn [(scan [vars vals]
(cond (empty? vars) (env-loop (enclosing-environment env))
(= var (first vars)) @(first vals)
:else (scan (rest vars) (rest vals))))]
(if (= env the-empty-environment)
(throw (RuntimeException. (str "Unbound variable: " var)))
(let [frame (first-frame env)]
(scan (frame-variables frame)
(frame-values frame))))))]
(env-loop env)))
(defn set-variable-value! [var val env]
(letfn [(env-loop [env]
(letfn [(scan [vars vals]
(cond (empty? vars) (env-loop (enclosing-environment env))
(= var (first vars)) (reset! (first vals) val)
:else (scan (rest vars) (rest vals))))]
(if (= env the-empty-environment)
(throw (RuntimeException. (str "Unbound variable: " var)))
(let [frame (first-frame env)]
(scan (frame-variables frame)
(frame-values frame))))))]
(env-loop env)))
(defn define-variable! [var val env]
(let [frame (first-frame env)]
(letfn [(scan [vars vals]
(cond (empty? vars) (add-binding-to-frame! var val frame)
(= var (first vars)) (reset! (first vals) val)
:else (scan (rest vars) (rest vals))))]
(scan (frame-variables frame)
(frame-values frame)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Expressions (ch.4.1.2)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare eval)
(declare apply)
(defn self-evaluating? [exp]
(cond (number? exp) true
(string? exp) true
:else false))
(defn variable? [exp]
(keyword? exp))
(defn quoted? [exp]
(tagged-list? exp :quote))
(defn text-of-quotation [exp]
(first (rest exp)))
(defn assignment? [exp]
(tagged-list? exp :set!))
(defn assignment-variable [exp] (nth exp 1))
(defn assignment-value [exp] (nth exp 2))
(defn eval-assignment [exp env]
(set-variable-value! (assignment-variable exp)
(eval (assignment-value exp) env)
env)
:ok)
(defn lambda? [exp]
(tagged-list? exp :lambda))
(defn lambda-parameters [exp]
(nth exp 1))
(defn lambda-body [exp]
(nth exp 2))
(defn make-lambda [parameters body]
(list :lambda parameters body))
;;; Exercise 4.6
(defn let? [exp]
(tagged-list? exp :let))
(defn let-parameters [exp]
(nth exp 1))
(defn let-vars [exp]
(map first (let-parameters exp)))
(defn let-values [exp]
(map second (let-parameters exp)))
(defn let-body [exp]
(nth exp 2))
(defn let->combination [exp]
(let [vars (let-vars exp)
values (let-values exp)
body (let-body exp)]
(cons (make-lambda vars (list body)) values)))
(defn definition? [exp]
(tagged-list? exp :define))
(defn definition-variable [exp]
(if (keyword? (nth exp 1))
(nth exp 1)
(first (nth exp 1))))
(defn definition-value [exp]
(if (keyword? (nth exp 1))
(nth exp 2)
(make-lambda (rest (nth exp 1))
(rest (rest exp)))))
(defn eval-definition [exp env]
(define-variable! (definition-variable exp)
(eval (definition-value exp) env)
env)
:ok)
(defn true? [x]
(not (= x false)))
(defn false? [x]
(= x false))
(defn if? [exp] (tagged-list? exp :if))
(defn if-predicate [exp] (nth exp 1))
(defn if-consequence [exp] (nth exp 2))
(defn if-alternative [exp]
(if (< 3 (count exp))
(nth exp 3)
false))
(defn make-if [predicate consequence alternative]
(list :if predicate consequence alternative))
(defn eval-if [exp env]
(if (true? (eval (if-predicate exp) env))
(eval (if-consequence exp) env)
(eval (if-alternative exp) env)))
;;; Exercise 4.4
(defn and? [exp] (tagged-list? exp :and))
(defn and-conds [conds] (rest conds))
(defn empty-cond? [conds] (empty? conds))
(defn next-cond [conds] (first conds))
(defn rest-cond [conds] (rest conds))
(defn eval-and [conds env]
(if (empty-cond? conds)
true
(and (true? (eval (next-cond conds) env)) (eval-and (rest-cond conds) env))))
(defn or? [exp] (tagged-list? exp :or))
(defn or-conds [conds] (rest conds))
(defn eval-or [conds env]
(if (empty-cond? conds)
false
(or (true? (eval (next-cond conds) env)) (eval-and (rest-cond conds) env))))
(defn begin? [exp]
(tagged-list? exp :begin))
(defn begin-actions [exp]
(rest exp))
(defn last-exp? [seq]
(empty? (rest seq)))
(defn first-exp [seq]
(first seq))
(defn rest-exps [seq]
(rest seq))
(defn eval-sequence [exps env]
(cond (last-exp? exps) (eval (first-exp exps) env)
:else (do
(eval (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
(defn make-begin [seq] (list :begin seq))
;;; Cond uses this to make one expression from a sequence of exps
(defn sequence->exp [seq]
(cond (empty? seq) seq
(last-exp? seq) (first-exp seq)
:else (make-begin seq)))
(defn cond? [exp]
(tagged-list? exp :cond))
(defn cond-clauses [exp] (rest exp))
(defn cond-predicate [clause] (first clause))
(defn cond-actions [clause] (rest clause))
(defn cond-else-clause? [exp]
(= (cond-predicate exp) :else))
;;; Exercise 4.5
(defn cond-extended? [exp]
(= (second exp) :=>))
(defn cond-extended-actions [exp]
(nth exp 2))
(defn expand-clauses [clauses]
(if (empty? clauses)
false
(let [first (first clauses) rest (rest clauses)]
(if (cond-else-clause? first)
(if (empty? rest)
(sequence->exp (cond-actions first))
(throw (RuntimeException. (str "else clause isn't last"))))
(make-if (cond-predicate first)
(if (cond-extended? first)
(list (cond-extended-actions first) (cond-predicate first))
(sequence->exp (cond-actions first)))
(expand-clauses rest))
))))
(defn cond->if [exp]
(expand-clauses (cond-clauses exp)))
(defn application? [exp] (coll? exp))
(defn operator [exp] (first exp))
(defn operands [exp] (rest exp))
(defn no-operands? [ops] (empty? ops))
(defn first-operand [ops] (first ops))
(defn rest-operands [ops] (rest ops))
(defn list-of-values [exps env]
(if (no-operands? exps)
'()
(cons (eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
;;; eval
(defn eval [exp env]
(cond (self-evaluating? exp) exp
(variable? exp) (lookup-variable-value exp env)
(quoted? exp) (text-of-quotation exp)
(assignment? exp) (eval-assignment exp env)
(definition? exp) (eval-definition exp env)
(if? exp) (eval-if exp env)
(and? exp) (eval-and (and-conds exp) env)
(or? exp) (eval-or (or-conds exp) env)
(lambda? exp) (make-procedure (lambda-parameters exp)
(lambda-body exp)
env)
(let? exp) (eval (let->combination exp) env)
(begin? exp) (eval-sequence (begin-actions exp) env)
(cond? exp) (eval (cond->if exp) env)
(application? exp) (apply (eval (operator exp) env)
(list-of-values (operands exp) env))
:else (throw (RuntimeException. (str "Unknown expression type: " exp)))))
;;; apply
(defn apply [procedure arguments]
(cond (primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)
(compound-procedure? procedure) (eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure)))
:else (throw (RuntimeException. (str "Unknown procedure type: " procedure)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tokenizer/Parser (NA)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn tokenize [input]
(let [pos (atom 0)]
(letfn [(peek-ch [] (if (nil? (get input @pos)) nil (str (get input @pos))))
(next-ch [] (let [ch (peek-ch)]
(reset! pos (+ @pos 1))
ch))]
(letfn [(next-chunk [] (let [ch (peek-ch)]
(cond
(nil? ch) nil
(or (= ch "(") (= ch ")") (= ch "\"") (= ch " ")) nil
:else (do
(next-ch)
(str ch (next-chunk))))))
(next-token [] (let [ch (next-ch)]
(cond
(nil? ch) nil
(or (= ch "(") (= ch ")") (= ch "\"") (= ch "'")) ch
(= ch " ") (next-token)
:else (str ch (next-chunk)))))]
next-token))))
(defn parse [input]
(let [tokens (tokenize input)]
(letfn [(parse-string []
(let [next (tokens)]
(if (= next "\"")
nil
(str next (parse-string)))))
(parse-symbol []
(let [next (tokens)]
(if (= next "(")
(list :quote (parse-main))
(list :quote (parse-num-or-kw next)))))
(parse-num-or-kw [token]
(if (number? (read-string token))
(read-string token)
(keyword token)))
(parse-main []
(let [token (tokens)]
(cond
(nil? token) '()
(= token "(") (cons (parse-main) (parse-main))
(= token ")") '()
(= token "\"") (cons (parse-string) (parse-main))
(= token "'") (cons (parse-symbol) (parse-main))
:else (cons (parse-num-or-kw token) (parse-main)))))]
(first (parse-main)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; REPL (ch.4.1.4)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn setup-environment []
(let [initial-env (extend-environment (primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)]
(define-variable! :true true initial-env)
(define-variable! :false false initial-env)
initial-env))
(def the-global-environment (setup-environment))
(def input-prompt ";;; M-Eval input:")
(def output-prompt ";;; M-Eval value:")
(defn prompt-for-input [string]
(println) (println string) (println))
(defn announce-output [string]
(println) (println string) (println))
(defn user-print [object]
(if (compound-procedure? object)
(println (list :compound-procedure (procedure-parameters object) (procedure-body object)))
(println object)))
(defn driver-loop []
(prompt-for-input input-prompt)
(letfn [(input [] (let [line (read-line)]
(if (= line "")
""
(str line (input)))))]
(let [output (eval (parse (input)) the-global-environment)]
(announce-output output-prompt)
(user-print output)))
(driver-loop))
(defn -main [& args]
(driver-loop))
(ns sicp.ch4-1-test
(:use [clojure.test :refer :all]
[sicp.ch4-1 :refer :all]))
(deftest true-false-test
(testing "true?"
(is (true? true))
(is (not (true? false)))
(is (true? :abc)))
(testing "false?"
(is (false? false))
(is (not (false? true)))
(is (not (false? :abc)))))
(deftest primitive-procedures-test
(testing "primitive-procedure?"
(is (primitive-procedure? (list :primitive :test nil)))
(is (not (primitive-procedure? (list :procedure :test nil)))))
(testing "primitive-implementation"
(is (= :test (primitive-implementation (list :primitive :test)))))
(testing "primitive-procedures"
(is (= :car (first (first primitive-procedures))))
(is (= first (second (first primitive-procedures)))))
(testing "primitive-procedures-names"
(is (= :car (first (primitive-procedure-names)))))
(testing "primitive-procedures-objects"
(is (= (list :primitive first) (first (primitive-procedure-objects)))))
(testing "apply-primitive-procedure"
(is (= (list 1 2) (apply-primitive-procedure (list :primitive cons) (list 1 (list 2)))))))
(deftest procedures-test
(testing "make-procedure"
(is (= (list :procedure (list :v1) nil '()) (make-procedure (list :v1) nil '()))))
(testing "compound-procedure?"
(is (compound-procedure? (list :procedure :params :body :env)))
(is (not (compound-procedure? (list :primitive :params :body :env)))))
(testing "procedure-parameters"
(is (= :params (procedure-parameters (list :procedure :params :body :env)))))
(testing "procedure-body"
(is (= :body (procedure-body (list :procedure :params :body :env)))))
(testing "procedure-environment"
(is (= :env (procedure-environment (list :procedure :params :body :env))))))
(deftest environments-test
(testing "enclosing-environment"
(is (= (list :e2) (enclosing-environment (list :e1 :e2)))))
(testing "first-frame"
(is (= :e1 (first-frame (list :e1 :e2)))))
(testing "the-empty-environment"
(is (= '() the-empty-environment)))
(testing "make-frame"
(is (= :var1 (first (first @(make-frame (list :var1) (list :val1))))))
(is (= :val1 @(first (second @(make-frame (list :var1) (list :val1)))))))
(testing "frame-variables"
(is (= (list :var1) (frame-variables (make-frame (list :var1) (list :val1))))))
(testing "frame-values"
(is (= :val1 @(first (frame-values (make-frame (list :var1) (list :val1)))))))
(testing "add-binding-to-frame!"
(let [frame (make-frame (list :var1) (list :val1))]
(add-binding-to-frame! :var2 :val2 frame)
(is (= (list :var2 :var1) (frame-variables frame)))
(is (= :val2 @(first (frame-values frame))))))
(testing "extend-environment"
(let [env (extend-environment (list :var1) (list :val1) (list (make-frame (list :var2) (list :val2))))]
(is (= (list :var1) (first @(first env))))
(is (= (list :var2) (first @(second env))))))
(testing "lookup-variable-value"
(let [env (extend-environment (list :var1 :var3) (list :val1 :val3) (list (make-frame (list :var2) (list :val2))))]
(is (= :val1 (lookup-variable-value :var1 env)))
(is (= :val2 (lookup-variable-value :var2 env)))
(is (= :val3 (lookup-variable-value :var3 env)))
(is (thrown? RuntimeException (lookup-variable-value :undefined env)))))
(testing "set-variable-value!"
(let [env (extend-environment (list :var1) (list :val1) (list (make-frame (list :var2) (list :val2))))]
(set-variable-value! :var1 :val3 env)
(set-variable-value! :var2 :val4 env)
(is (= :val3 (lookup-variable-value :var1 env)))
(is (= :val4 (lookup-variable-value :var2 env)))
(is (thrown? RuntimeException (set-variable-value! :undefined :v env)))))
(testing "define-variable!"
(let [env (list (make-frame (list :var1) (list :val1)))]
(define-variable! :var2 :val2 env)
(is (= :val2 (lookup-variable-value :var2 env)))
(define-variable! :var1 :val3 env)
(is (= :val3 (lookup-variable-value :var1 env))))))
(deftest eval-test
(testing "self-evaluating?"
(is (self-evaluating? 1))
(is (self-evaluating? "a"))
(is (not (self-evaluating? :a))))
(testing "variable?"
(is (variable? :a))
(is (not (variable? "a"))))
(testing "quoted?"
(is (quoted? (list :quote nil)))
(is (not (quoted? (list :not-quote)))))
(testing "text-of-quotation"
(is (= "a" (text-of-quotation (list :quote "a")))))
(testing "assignment?"
(is (assignment? (list :set!))))
(testing "assignment-variable"
(is (= :var (assignment-variable (list :set! :var :val)))))
(testing "assignment-value"
(is (= :val (assignment-value (list :set! :var :val)))))
(testing "eval-assignment"
(let [env (list (make-frame (list :var1 :var2) (list 1 2)))]
(eval-assignment (list :set! :var1 3) env)
(is (= 3 (lookup-variable-value :var1 env)))
(eval-assignment (list :set! :var2 :var1) env)
(is (= 3 (lookup-variable-value :var2 env)))
(is (thrown? RuntimeException (eval-assignment (list :set! :var3 3) env)))))
(testing "lambda?"
(is (lambda? (list :lambda))))
(testing "lambda-parameters"
(is (= :params (lambda-parameters (list :lambda :params :body)))))
(testing "lambda-body"
(is (= :body (lambda-body (list :lambda :params :body)))))
(testing "make-lambda"
(is (= (list :lambda :params :body) (make-lambda :params :body))))
(testing "definition?"
(is (definition? (list :define))))
(testing "definition-variable"
(is (= :var1 (definition-variable (list :define :var1))))
(is (= :var1 (definition-variable (list :define (list :var1))))))
(testing "definition-value"
(is (= 1 (definition-value (list :define :var1 1))))
(is (= (list :lambda (list :param) (list :body)) (definition-value (list :define (list :var1 :param) :body)))))
(testing "eval-definition"
(let [env (list (make-frame (list :var1) (list 1)))]
(eval-definition (list :define :var2 2) env)
(is (= 2 (lookup-variable-value :var2 env)))
(eval-definition (list :define :var3 :var2) env)
(is (= 2 (lookup-variable-value :var3 env)))))
(testing "if?"
(is (if? (list :if))))
(testing "if-predicate"
(is (= :pred (if-predicate (list :if :pred)))))
(testing "if-consequence"
(is (= :conseq (if-consequence (list :if :pred :conseq)))))
(testing "if-alternative"
(is (= :alt (if-alternative (list :if :pred :conseq :alt))))
(is (= false (if-alternative (list :if :pred :conseq)))))
(testing "make-if"
(is (= (list :if :pred :conseq :alt) (make-if :pred :conseq :alt))))
(testing "eval-if"
(is (= 1 (eval-if (make-if 1 1 0) '())))
(is (= 0 (eval-if (make-if :v1 1 0) (list (make-frame (list :v1) (list false)))))))
(testing "begin?"
(is (begin? (list :begin))))
(testing "begin-actions"
(is (= (list :action1) (begin-actions (list :begin :action1)))))
(testing "last-exp?"
(is (not (last-exp? (list :action1 :action2))))
(is (last-exp? (list :action1))))
(testing "first-exp"
(is (= :action1 (first-exp (list :action1 :action2)))))
(testing "rest-exps"
(is (= (list :action2) (rest-exps (list :action1 :action2)))))
(testing "eval-sequence"
(is (= 3 (eval-sequence (list 0 1 2 3) '()))))
(testing "make-begin"
(is (= (list :begin (list 0 1)) (make-begin (list 0 1)))))
(testing "sequence->exp"
(is (= (list :begin (list 0 1)) (sequence->exp (list 0 1))))
(is (= '() (sequence->exp '())))
(is (= 0 (sequence->exp (list 0)))))
(testing "cond?"
(is (cond? (list :cond))))
(testing "cond-clauses"
(is (= (list :c1 :a1) (cond-clauses (list :cond :c1 :a1)))))
(testing "cond-predicate"
(is (= :c1 (cond-predicate (list :c1 :a1)))))
(testing "cond-actions"
(is (= (list :a1 :a2) (cond-actions (list :c1 :a1 :a2)))))
(testing "cond-else-clause?"
(is (cond-else-clause? (list :else :a1))))
(testing "expand-clauses"
(is (= (list :if :c1 :a1 false) (expand-clauses (list (list :c1 :a1)))))
(is (= :a2 (expand-clauses (list (list :else :a2)))))
(is (= (list :if :c1 :a1 :a2) (expand-clauses (list (list :c1 :a1) (list :else :a2)))))
(is (= (list :if :c1 :a1 (list :if :c2 :a2 :a3)) (expand-clauses (list (list :c1 :a1) (list :c2 :a2) (list :else :a3)))))
)
(testing "cond->if"
(is (= (list :if :c1 :a1 false) (cond->if (list :cond (list :c1 :a1))))))
(testing "application?"
(is (application? (list 1))))
(testing "operator"
(is (= :+ (operator (list :+ :1 :1)))))
(testing "operands"
(is (= (list :1 :1) (operands (list :+ :1 :1)))))
(testing "no-operands?"
(is (not (no-operands? (list :1 :1))))
(is (no-operands? '())))
(testing "first-operand"
(is (= :1 (first-operand (list :1 :1)))))
(testing "rest-operands"
(is (= (list :1) (rest-operands (list :1 :1)))))
(testing "list-of-values"
(is (= (list 1 2) (list-of-values (list :var1 :var2) (list (make-frame (list :var1 :var2) (list 1 2)))))))
(testing "eval"
(let [env (list (make-frame (list :var1) (list 1)))]
(is (= 1 (eval 1 env)))
(is (= 1 (eval :var1 env)))
(is (= :a (eval (list :quote :a) env)))
;; assignment
(eval (list :set! :var1 2) env)
(is (= 2 (eval :var1 env)))
(eval (list :set! :var1 1) env)
;; define
(eval (list :define :var2 2) env)
(is (= 2 (eval :var2 env)))
;; if
(eval (list :if 1 (list :set! :var1 2) :set! :var1 3) env)
(is (= 2 (eval :var1 env)))
(eval (list :set! :var1 1) env)
;; lambda
(is (= (list :procedure :params :body env) (eval (list :lambda :params :body) env)))
;; begin
(is (= 2 (eval (list :begin :var1 :var2) env)))
;; cond
(is (= 2 (eval (list :cond (list :var1 :var2)) env)))
;; application
(eval (list :define (list :f) (list :set! :var1 2)) env)
(eval (list :f) env)
(is (= 2 (eval :var1 env)))
(eval (list :set! :var1 1) env)
(is (thrown? RuntimeException (eval nil env)))
)))
(deftest apply-test
(testing "apply primitive proc"
(is (= '(1 2) (apply (list :primitive cons) (list 1 '(2))))))
(testing "apply compound proc"
(is (= 1 (apply (list :procedure (list :var1) (list :var1) '()) (list 1))))
(is (= 1 (apply (list :procedure (list :var1) (list (list :define :var2 :var1) :var2) '()) (list 1))))))
(deftest parse-and-eval-test
(let [the-global-environment (setup-environment)]
(letfn [(ev [input] (eval (parse input) the-global-environment))]
(testing "self-eval"
(is (= 1 (ev "1")))
(is (= "str" (ev "\"str\""))))
(testing "lookup-var"
(ev "(define var1 1)")
(is (= 1 (ev "var1"))))
(testing "quoted"
(is (= :sym (ev "'sym")))
(is (= (list :a :b) (ev "'(a b)"))))
(testing "assignment"
(ev "(define var1 1)")
(is (= 1 (ev "var1")))
(ev "(set! var1 2)")
(is (= 2 (ev "var1")))
(ev "(define var2 var1)")
(is (= 2 (ev "var2"))))
(testing "if"
(is (= :t (ev "(if true 't 'f)")))
(is (= :f (ev "(if false 't 'f)"))))
(testing "and"
(is (ev "(and true 1 'a)"))
(is (not (ev "(and true false)")))
(is (ev "(and)")))
(testing "or"
(is (ev "(or true false)"))
(is (not (ev "(or false false)")))
(is (not (ev "(or)"))))
(testing "lambda"
(is (= :procedure (first (ev "(lambda (x) (* x x))"))))
(is (= (list :x) (second (ev "(lambda (x) (* x x))"))))
(is (= (list :* :x :x) (second (rest (ev "(lambda (x) (* x x))"))))))
(testing "let"
(is (= 3 (ev "(let ((v1 1) (v2 2)) (+ v1 v2))"))))
(testing "begin"
(ev "(define var1 1)")
(ev "(define var2 1)")
(ev "(begin (set! var1 2) (set! var2 2)")
(is (= 2 (ev "var1")))
(is (= 2 (ev "var2"))))
(testing "cond"
(is (= 1 (ev "(cond (false 0) (true 1))")))
(is (= 2 (ev "(cond (false 0) (false 1) (else 2))"))))
(testing "extended-cond"
(is (= 2 (ev "(cond ((cdr '(1 2 3)) => car) (else false))")))
(is (= 1 (ev "(cond (false => car) (else 1))"))))
(testing "apply primitive"
(is (= :a (ev "(car '(a b c))")))
(is (= 1 (ev "(car '(1 2 3))")))
(is (= (list :b :c) (ev "(cdr '(a b c))")))
(is (= (list :a :b :c) (ev "(cons 'a '(b c))")))
(is (= 3 (ev "(+ 1 2)")))
(is (= 1 (ev "(- 2 1)")))
(is (= 6 (ev "(* 2 3)")))
(is (= 2 (ev "(/ 6 3)")))
(is (= false (ev "(null? 'a)")))
(is (= true (ev "(null? (cdr '(a)))"))))
(testing "apply procedure"
(ev "(define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y))))")
(is (= (list 1 2 3) (ev "(append '(1 2) '(3))")))
(is (= (list :a :b :c) (ev "(append '(a b c) '())"))))
)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment