; The Little Schemer in Clojure ; Chapter 10 - What is the value of all this? ; A Scheme Interpreter in Clojure ; ; http://j...content-available-to-author-only...e.com/blog/2012/10/15/the-little-schemer-in-clojure-chapter-10-what-is-the-value-of-all-this-a-simple-scheme-evaluator-in-clojure/ ; (ns Chapter10WhatIsTheValueOfAllThis) (def null? (fn [a] (or (nil? a) (= () a)))) (println "") (def atom? (fn [a] (not (seq? a)))) (def build (fn [a b] (cons a (cons b '() )))) (println "") (println "build") (println (build 'a 'b)) ;//=>(a b) (def new-entry build) (println "") (println "new-entry") (println (new-entry 'a 'b)) (def lookup-in-entry-help (fn [name names values entry-f] (cond (empty? names) (entry-f name) (= (first names) name) (first values) true (lookup-in-entry-help name (rest names) (rest values) entry-f)))) (println "") (println "lookup-in-entry-help") (println (lookup-in-entry-help 'entree '(mains dessert) '(chicken icecream) println)) ;//=>entree (println (lookup-in-entry-help 'entree '(entree mains dessert) '(garlicbread chicken icecream) println)) ;//=>garlicbread (def couldntfind (fn [a] (println "couldn't find" a))) (println "") (println "couldntfind") (println (couldntfind 'wally)) ;//=>couldn't find wally (println (lookup-in-entry-help 'entree '(mains dessert) '(chicken icecream) couldntfind)) ;//=>couldn't find entree (def first_ (fn [p] (cond true (first p)))) (println "") (println "first_") (println (first_ '(a b))) ;//=>a (def second_ (fn [p] (cond true (first (rest p))))) (println "") (println "second_") (println (second_ '(a b))) ;//=>b (def third_ (fn [p] (cond true (first (rest (rest p)))))) (println "") (println "third_") (println (third_ '(a b c))) ;//=>c (def lookup-in-entry (fn [name entry entry-f] (lookup-in-entry-help name (first_ entry) (second_ entry) entry-f))) (println "") (println "lookup-in-entry") (println (lookup-in-entry 'entree '((entree mains dessert) (garlicbread chicken icecream)) println)) ;//=>garlicbread (println (lookup-in-entry 'entree '((mains dessert) (chicken icecream)) couldntfind)) ;//=>couldn't find entree (def extend-table cons) (println "") (println "extend-table") (println (extend-table '((breakfast lunch)(toast sandwiches)) '(((mains dessert)(beef fruit))))) ;//=>(((breakfast lunch) (toast sandwiches)) ((mains dessert) (beef fruit))) (def lookup-in-table (fn [name table table-f] (cond (null? table) (table-f name) true (lookup-in-entry name (first table) (fn [name] (lookup-in-table name (rest table) table-f)))))) (println "") (println "lookup-in-table") (println (lookup-in-table 'mains '( ((mains dessert) (steak gelato))) println)) ;//=> steak (println (lookup-in-table 'mains '(((starter entree) (bread soup)) ((mains dessert) (steak gelato))) println)) ;//=>steak (def *self-evaluating (fn [e table] e)) (println "") (println "*self-evaluating") (println (*self-evaluating '(+ 1 1) '() )) ;//=>(+ 1 1) (println (*self-evaluating '1 '() )) ;//=> 1 (def initial-table (fn [name] (cond (= name 't) true (= name 'nil) nil true (build 'primitive name)))) (println "") (println "intial-table") (println (initial-table 'a)) ;//=>(primitive a) (def *identifier (fn [e table] (lookup-in-table e table initial-table))) (println "") (println "*identifier") (println (*identifier 'a '() )) ;//=>(primitive a) (def atom-to-action (fn [e] (cond (number? e) *self-evaluating true *identifier))) (println "") (println "atom-to-action") (println (atom-to-action '1)) ;//=>*self-evaluating (println (atom-to-action 'cons)) ;//=>*identifier (def text-of-quotation second_) (println "") (println "text-of-quotation") (println (text-of-quotation '(quote helloWorld))) ;//=> helloWorld (println (text-of-quotation '(quote hello world))) ;//=>hello (def *quote (fn [e table] (text-of-quotation e))) (println "") (println "*quote") (println (*quote '(quote helloWorld) '() )) ;//=> helloWorld (def *lambda (fn [e table] (build 'non-primitive (cons table (rest e))))) (println "") (println "*lambda") (println (*lambda '(*lambda (b) (println b)) '() )) ;//=>(non-primitive (() (b) (println b))) (def question-of first_) (println "") (println "question-of") (println (question-of '((= 1 a) (println true)))) ;//=>(= 1 a) (def answer-of second_) (println "") (println "answer-of") (println (answer-of '((= 1 a) (println true)))) ;//=>(println true) ; stub this out to make it easier to load later (def meaning) (def evcon (fn [lines table] (cond (meaning (question-of (first lines)) table) (meaning (answer-of (first lines)) table) true (evcon (rest lines) table)))) (def cond-lines rest) (def *cond (fn [e table] (evcon (cond-lines e) table))) ; stub this out for later definition (cyclical dependencies) (def *application) (def list-to-action (fn [e] (cond (atom? (first e)) (cond (= (first e) 'quote) *quote (= (first e) 'lambda) *lambda (= (first e) 'cond) *cond true *application) true *application))) (println "") (println "list-to-action") (println (list-to-action '(null? 'null))) ;//=>*application (println (list-to-action '(lambda 'a))) ;//=>*lambda (def expression-to-action (fn [e] (cond (atom? e) (atom-to-action e) true (list-to-action e)))) (println "") (println "expression-to-action") (println (expression-to-action '(lambda a))) ;//=>*lambda (println (expression-to-action 'a)) ;//=>*identifier (println (expression-to-action '1)) ;//=> *self-evaluating (def meaning (fn [e table] ((expression-to-action e) e table))) (def value (fn [e] (meaning e '() ))) (def table-of first_) (println "") (println "table-of") (println (table-of '((first second) (third forth)))) ;//=>(first second) (println (table-of '(*lambda (args0) functionBody))) ;//=>*lambda (def formals-of second_) (println "") (println "formals-of") (println (formals-of '((first second) (third forth)))) ;//=>(third forth) (println (formals-of '(*lambda (args0) functionBody))) ;//=>(args0) (def body-of third_) (println "") (println "third_") (println (body-of '(*lambda (args0) functionBody))) ;//=>functionBody (def evlis (fn [args table] (cond (null? args) '() true (cons (meaning (first args) table) (evlis (rest args) table))))) (println "") (println "evlis") (println (evlis '(+ 1 a) '() )) ;//=>(() () ()) (def function-of first_) (println "") (println "function-of") (println (function-of '(+ 1 1))) ;//=> + (def arguments-of rest) (println "") (println "arguments-of") (println (arguments-of '(+ 1 1))) (def primitive? (fn [l] (= (first_ l) 'primitive))) (println "") (println "primitive?") (println (primitive? '(primitive a))) ;//=> true (def non-primitive? (fn [l] (= (first_ l) 'non-primitive))) (println "") (println "non-primitive?") (println (non-primitive? '(non-primitive a))) ;//=> true (def add1 (fn [n] (+ 1 n))) (println "") (println "add1") (println (add1 2)) ;//=> 3 (def sub1 (fn [n] (- n 1))) (println "") (println "sub1") (println (sub1 2)) ;//=> 1 (def apply-primitive (fn [name vals] (cond (= name 'car ) (first (first_ vals)) (= name 'cdr ) (rest (first_ vals)) (= name 'cons ) (cons (first_ vals) (second_ vals)) (= name 'eq ) (= (first_ vals) (second_ vals)) (= name 'atom? ) (atom? (first_ vals)) (= name 'not ) (not (first_ vals)) (= name 'null? ) (null? (first_ vals)) (= name 'number? ) (number? (first_ vals)) (= name 'zero? ) (zero? (first_ vals)) (= name 'add1 ) (add1 (first_ vals)) (= name 'sub1 ) (sub1 (first_ vals))))) (def apply-closure (fn [closure vals] (meaning (body-of closure) (extend-table (new-entry (formals-of closure) vals) (table-of closure))))) (def apply_ (fn [fun vals] (cond (primitive? fun) (apply-primitive (second_ fun) vals) (non-primitive? fun) (apply-closure (second_ fun) vals)))) (println "") (println "apply_") (def *application (fn [e table] (apply_ (meaning (function-of e) table) (evlis (arguments-of e) table)))) (println "") (println "*application") ;(println (*application '(+ 1 1) '() )) ;*** not a good example (println "") (println "meaning") (println (meaning '(+ 1 1) '() )) ;//=>() (println (meaning '1 '() )) (println "") (println "evcon") (println (evcon '((= 1 a) (println true)) '() )) ;//=>() (println "") (println "cond-lines") (println (cond-lines '(cond ((= 1 a) (println true)) (true 1)))) ;//=>(((= 1 a) (println true)) (true 1)) (println "") (println "*cond") (println (*cond '(cond ((= 1 a) (println true)) (true 1)) '() )) ;//=>() (println "") (println "value") (println (value '(+ 1 1))) ;//=>() (println "") (println "apply-primitive") (println (apply-primitive 'atom? '(1) )) ;//=> true (println "") (println "apply-closure") (println (apply-closure '((((u v w) (1 2 3)) ((x y z) (4 5 6))) (x y) (cons z x)) '((a b c) (d e f)))) ;//=> (((x y) ((a b c) (d e f))) ((u v w) (1 2 3)) ((x y z) (4 5 6))) (def cons_ (fn [u v] (fn [b] (cond b u true v)))) (println "") (println "cons_") (println (cons_ 'apple '() )) ;//=> # (def lunch (cons_ 'apple '() )) (println "") (println "lunch") (println (lunch 'apple )) ;//=> 'apple (println (lunch '1 )) ;//=> apple (println (lunch nil )) ;//=> () (def car_ (fn [l] (l true))) (println "") (println "car_") (println (car_ lunch)) ;//=> apple (def cdr_ (fn [l] (l nil))) (println "") (println "cdr_") (println (cdr_ lunch)) ;//=> () (println (value '(add1 1))) ;//=> 2 (println (value '(eq 2 1))) ;//=> false (println (value '(eq 1 1))) ;//=> true (println (value '(quote hello))) ;//=> hello (println (value '((lambda (x) 1) 2))) ;//=> 1 (println (value '((lambda (x) x) 2))) ;//=> 2 (println (value '((lambda (x) (add1 x)) 2))) ;//=> 3 (println (value '(((lambda (y) (lambda (x) 1) y) 4) 3))) ;//=> 1 (println (value '(((lambda (y) (lambda (x) x) y) 4) 3))) ;//=> 3 (println (value '(((lambda (x y) (lambda (u) (cond (u x) (t y)))) 1 '() ) nil))) ;//=> () (println (value '((lambda (x) ((lambda (x) (add1 x)) (add1 4))) 6))) ;//=> 6