fork download
copy 
  1. ; The Little Schemer in Clojure
  2. ; Chapter 10 - What is the value of all this?
  3. ; A Scheme Interpreter in Clojure
  4. ;
  5. ; 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/
  6. ; 
  7. (ns Chapter10WhatIsTheValueOfAllThis)
  8.  
  9. (def null?
  10.   (fn [a]
  11.     (or
  12.       (nil? a)
  13.       (= () a))))
  14. (println "")
  15.  
  16. (def atom?
  17.   (fn [a]
  18.     (not (seq? a))))
  19.  
  20. (def build 
  21.   (fn [a b]
  22.   (cons a (cons b '() ))))
  23.  
  24. (println "")
  25. (println "build")
  26. (println (build 'a 'b))
  27. ;//=>(a b)
  28.  
  29. (def new-entry build)
  30. (println "")
  31. (println "new-entry")
  32. (println (new-entry 'a 'b))
  33.  
  34. (def lookup-in-entry-help 
  35.   (fn [name names values entry-f]
  36.     (cond
  37.       (empty? names) (entry-f name)
  38.       (= (first names) name)
  39.       (first values)
  40.       true (lookup-in-entry-help
  41.              name
  42.              (rest names)
  43.              (rest values)
  44.              entry-f))))
  45.  
  46.  
  47. (println "")
  48. (println "lookup-in-entry-help")
  49. (println (lookup-in-entry-help 'entree '(mains dessert) '(chicken icecream) println))
  50. ;//=>entree
  51. (println (lookup-in-entry-help 'entree '(entree mains dessert) '(garlicbread chicken icecream) println))
  52. ;//=>garlicbread
  53.  
  54. (def couldntfind
  55.   (fn [a]
  56.     (println "couldn't find" a)))
  57.  
  58. (println "")
  59. (println "couldntfind")
  60. (println (couldntfind 'wally))
  61. ;//=>couldn't find wally
  62. (println (lookup-in-entry-help 'entree '(mains dessert) '(chicken icecream) couldntfind))
  63. ;//=>couldn't find entree            
  64.  
  65. (def first_
  66.   (fn [p]
  67.     (cond
  68.       true (first p))))
  69.  
  70. (println "")
  71. (println "first_")
  72. (println (first_ '(a b)))
  73. ;//=>a
  74.  
  75. (def second_
  76.   (fn [p]
  77.     (cond
  78.       true (first (rest p)))))
  79.  
  80. (println "")
  81. (println "second_")
  82. (println (second_ '(a b)))
  83. ;//=>b
  84.  
  85. (def third_
  86.   (fn [p]
  87.     (cond
  88.       true (first (rest (rest p))))))
  89.  
  90. (println "")
  91. (println "third_")
  92. (println (third_ '(a b c)))
  93. ;//=>c
  94.  
  95.  
  96. (def lookup-in-entry 
  97.   (fn [name entry entry-f]
  98.     (lookup-in-entry-help
  99.       name
  100.       (first_ entry)
  101.       (second_ entry)
  102.       entry-f)))
  103.  
  104. (println "")
  105. (println "lookup-in-entry")
  106. (println (lookup-in-entry 'entree '((entree mains dessert) (garlicbread chicken icecream)) println))
  107. ;//=>garlicbread
  108. (println (lookup-in-entry 'entree '((mains dessert) (chicken icecream)) couldntfind))
  109. ;//=>couldn't find entree
  110.  
  111. (def extend-table cons)
  112.  
  113. (println "")
  114. (println "extend-table")
  115. (println (extend-table '((breakfast lunch)(toast sandwiches)) '(((mains dessert)(beef fruit)))))
  116. ;//=>(((breakfast lunch) (toast sandwiches)) ((mains dessert) (beef fruit)))
  117.  
  118. (def lookup-in-table
  119.   (fn [name table table-f]
  120.     (cond
  121.       (null? table) (table-f name)
  122.       true (lookup-in-entry
  123.              name
  124.              (first table)
  125.              (fn [name]
  126.                (lookup-in-table
  127.                  name
  128.                  (rest table)
  129.                  table-f))))))
  130.  
  131. (println "")
  132. (println "lookup-in-table")
  133. (println (lookup-in-table 'mains '( ((mains dessert) (steak gelato))) println))
  134. ;//=> steak
  135. (println (lookup-in-table 'mains '(((starter entree) (bread soup)) ((mains dessert) (steak gelato))) println))
  136. ;//=>steak
  137.  
  138. (def *self-evaluating
  139.   (fn [e table]
  140.     e))
  141.  
  142. (println "")
  143. (println "*self-evaluating")
  144. (println (*self-evaluating '(+ 1 1) '() ))
  145. ;//=>(+ 1 1)
  146. (println (*self-evaluating '1 '() ))
  147. ;//=> 1
  148.  
  149. (def initial-table
  150.   (fn [name]
  151.     (cond
  152.       (= name 't) true
  153.       (= name 'nil) nil
  154.       true (build 'primitive name))))
  155.  
  156. (println "")
  157. (println "intial-table")
  158. (println (initial-table 'a))
  159. ;//=>(primitive a)
  160.  
  161.  
  162. (def *identifier
  163.   (fn [e table]
  164.     (lookup-in-table
  165.       e table initial-table)))
  166.  
  167. (println "")
  168. (println "*identifier")
  169. (println (*identifier 'a '() ))
  170. ;//=>(primitive a)
  171.  
  172.  
  173. (def atom-to-action
  174.   (fn [e]
  175.     (cond
  176.       (number? e) *self-evaluating
  177.       true *identifier)))
  178.  
  179. (println "")
  180. (println "atom-to-action")
  181. (println (atom-to-action '1))
  182. ;//=>*self-evaluating
  183. (println (atom-to-action 'cons))
  184. ;//=>*identifier
  185.  
  186.  
  187. (def text-of-quotation second_)
  188.  
  189. (println "")
  190. (println "text-of-quotation")
  191. (println (text-of-quotation '(quote helloWorld)))
  192. ;//=> helloWorld
  193. (println (text-of-quotation '(quote hello world)))
  194. ;//=>hello
  195.  
  196.  
  197. (def *quote
  198.   (fn [e table]
  199.     (text-of-quotation e)))
  200.  
  201. (println "")
  202. (println "*quote")
  203. (println (*quote '(quote helloWorld) '() ))
  204. ;//=> helloWorld
  205.  
  206.  
  207.  
  208. (def *lambda
  209.   (fn [e table]
  210.     (build 'non-primitive
  211.            (cons table (rest e)))))
  212.  
  213. (println "")
  214. (println "*lambda")
  215. (println (*lambda '(*lambda (b) (println b)) '() ))
  216. ;//=>(non-primitive (() (b) (println b)))
  217.  
  218.  
  219. (def question-of first_)
  220.  
  221. (println "")
  222. (println "question-of")
  223. (println (question-of '((= 1 a) (println true))))
  224. ;//=>(= 1 a)
  225.  
  226.  
  227. (def answer-of second_)
  228.  
  229. (println "")
  230. (println "answer-of")
  231. (println (answer-of '((= 1 a) (println true))))
  232. ;//=>(println true)
  233.  
  234. ; stub this out to make it easier to load later
  235. (def meaning)
  236.  
  237.  
  238. (def evcon
  239.   (fn [lines table]
  240.     (cond
  241.       (meaning 
  242.         (question-of (first lines)) table)
  243.       (meaning 
  244.         (answer-of (first lines)) table)
  245.       true (evcon (rest lines) table))))
  246.  
  247.  
  248. (def cond-lines rest)
  249.  
  250.  
  251. (def *cond
  252.   (fn [e table]
  253.     (evcon (cond-lines e) table)))
  254.  
  255. ; stub this out for later definition (cyclical dependencies)
  256. (def *application)
  257.  
  258.  
  259. (def list-to-action
  260.   (fn [e]
  261.     (cond
  262.       (atom? (first e)) (cond
  263.                           (= (first e) 'quote) *quote
  264.                           (= (first e) 'lambda) *lambda
  265.                           (= (first e) 'cond) *cond
  266.                           true *application)
  267.       true *application)))
  268.  
  269. (println "")
  270. (println "list-to-action")
  271. (println (list-to-action '(null? 'null)))
  272. ;//=>*application
  273. (println (list-to-action '(lambda 'a)))
  274. ;//=>*lambda
  275.  
  276.  
  277. (def expression-to-action
  278.   (fn [e]
  279.     (cond
  280.       (atom? e) (atom-to-action e)
  281.       true (list-to-action e))))
  282.  
  283. (println "")
  284. (println "expression-to-action")
  285. (println (expression-to-action '(lambda a)))
  286. ;//=>*lambda
  287. (println (expression-to-action 'a))
  288. ;//=>*identifier
  289. (println (expression-to-action '1))
  290. ;//=> *self-evaluating
  291.  
  292. (def meaning
  293.   (fn [e table]
  294.     ((expression-to-action e) e table)))
  295.  
  296.  
  297. (def value
  298.   (fn [e]
  299.     (meaning e '() )))
  300.  
  301.  
  302. (def table-of first_)
  303.  
  304. (println "")
  305. (println "table-of")
  306. (println (table-of '((first second) (third forth))))
  307. ;//=>(first second)
  308. (println (table-of '(*lambda (args0) functionBody)))
  309. ;//=>*lambda
  310.  
  311.  
  312. (def formals-of second_)
  313.  
  314. (println "")
  315. (println "formals-of")
  316. (println (formals-of '((first second) (third forth))))
  317. ;//=>(third forth)
  318. (println (formals-of '(*lambda (args0) functionBody)))
  319. ;//=>(args0)
  320.  
  321. (def body-of third_)
  322.  
  323. (println "")
  324. (println "third_")
  325. (println (body-of '(*lambda (args0) functionBody)))
  326. ;//=>functionBody
  327.  
  328.  
  329. (def evlis
  330.   (fn [args table]
  331.     (cond
  332.       (null? args) '()
  333.       true (cons (meaning (first args) table)
  334.                  (evlis (rest args) table)))))
  335.  
  336. (println "")
  337. (println "evlis")
  338. (println (evlis '(+ 1 a) '() ))
  339. ;//=>(() () ())
  340.  
  341.  
  342. (def function-of  first_)
  343.  
  344. (println "")
  345. (println "function-of")
  346. (println (function-of '(+ 1 1)))
  347. ;//=> +
  348.  
  349.  
  350. (def arguments-of rest)
  351.  
  352. (println "")
  353. (println "arguments-of")
  354. (println (arguments-of '(+ 1 1)))
  355.  
  356.  
  357. (def primitive?
  358.   (fn [l]
  359.     (= (first_ l) 'primitive)))
  360.  
  361. (println "")
  362. (println "primitive?")
  363. (println (primitive? '(primitive a)))
  364. ;//=> true
  365.  
  366.  
  367.  
  368. (def non-primitive?
  369.   (fn [l]
  370.     (= (first_ l) 'non-primitive)))
  371.  
  372. (println "")
  373. (println "non-primitive?")
  374. (println (non-primitive? '(non-primitive a)))
  375. ;//=> true
  376.  
  377.  
  378. (def add1
  379.   (fn [n]
  380.     (+ 1 n)))
  381.  
  382. (println "")
  383. (println "add1")
  384. (println (add1 2))
  385. ;//=> 3
  386.  
  387. (def sub1
  388.   (fn [n]
  389.     (- n 1)))
  390.  
  391. (println "")
  392. (println "sub1")
  393. (println (sub1 2))
  394. ;//=> 1
  395.  
  396. (def apply-primitive
  397.   (fn [name vals]
  398.     (cond
  399.       (= name 'car ) (first (first_ vals))
  400.       (= name 'cdr ) (rest (first_ vals))
  401.       (= name 'cons ) (cons (first_ vals) (second_ vals))
  402.       (= name 'eq ) (= (first_ vals) (second_ vals))
  403.       (= name 'atom? ) (atom? (first_ vals))
  404.       (= name 'not ) (not (first_ vals))
  405.       (= name 'null? ) (null? (first_ vals))
  406.       (= name 'number? ) (number? (first_ vals))
  407.       (= name 'zero? ) (zero? (first_ vals))
  408.       (= name 'add1 ) (add1 (first_ vals))
  409.       (= name 'sub1 ) (sub1 (first_ vals)))))
  410.  
  411. (def apply-closure
  412.   (fn [closure vals]
  413.     (meaning (body-of closure)
  414.              (extend-table
  415.                (new-entry
  416.                  (formals-of closure) vals)
  417.                (table-of closure)))))
  418.  
  419.  
  420. (def apply_
  421.   (fn [fun vals]
  422.     (cond
  423.       (primitive? fun) (apply-primitive (second_ fun) vals)
  424.       (non-primitive? fun) (apply-closure (second_ fun) vals))))
  425.  
  426. (println "")
  427. (println "apply_")
  428.  
  429.  
  430. (def *application
  431.   (fn [e table]
  432.     (apply_
  433.       (meaning (function-of e) table)
  434.       (evlis (arguments-of e) table))))
  435.  
  436. (println "")
  437. (println "*application")
  438. ;(println (*application '(+ 1 1) '() ))
  439. ;*** not a good example
  440.  
  441.  
  442. (println "")
  443. (println "meaning")
  444. (println (meaning '(+ 1 1) '() ))
  445. ;//=>()
  446. (println (meaning '1 '() ))
  447.  
  448. (println "")
  449. (println "evcon")
  450. (println (evcon '((= 1 a) (println true)) '() ))
  451. ;//=>()
  452.  
  453. (println "")
  454. (println "cond-lines")
  455. (println (cond-lines '(cond ((= 1 a) (println true)) (true 1))))
  456. ;//=>(((= 1 a) (println true)) (true 1))
  457.  
  458. (println "")
  459. (println "*cond")
  460. (println (*cond '(cond ((= 1 a) (println true)) (true 1)) '() ))
  461. ;//=>()
  462.  
  463. (println "")
  464. (println "value")
  465. (println (value '(+ 1 1)))
  466. ;//=>()
  467.  
  468. (println "")
  469. (println "apply-primitive")
  470. (println (apply-primitive 'atom? '(1) ))
  471. ;//=> true
  472.  
  473.  
  474. (println "")
  475. (println "apply-closure")
  476. (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))))
  477. ;//=> (((x y) ((a b c) (d e f))) ((u v w) (1 2 3)) ((x y z) (4 5 6)))
  478.  
  479.  
  480. (def cons_
  481.   (fn [u v]
  482.     (fn [b]
  483.       (cond
  484.         b u
  485.         true v))))
  486.  
  487. (println "")
  488. (println "cons_")
  489. (println (cons_ 'apple '() ))
  490. ;//=> #<Chapter10WhatIsTheValueOfAllThis$cons_$fn__862 Chapter10WhatIsTheValueOfAllThis$cons_$fn__862@272b72f4>
  491.  
  492.  
  493.  
  494. (def lunch (cons_ 'apple '() ))
  495.  
  496. (println "")
  497. (println "lunch")
  498. (println (lunch 'apple ))
  499. ;//=> 'apple
  500. (println (lunch '1 ))
  501. ;//=> apple
  502. (println (lunch nil ))
  503. ;//=> ()
  504.  
  505.  
  506. (def car_
  507.   (fn [l]
  508.     (l true)))
  509.  
  510. (println "")
  511. (println "car_")
  512. (println (car_ lunch))
  513. ;//=> apple
  514.  
  515.  
  516. (def cdr_
  517.   (fn [l]
  518.     (l nil)))
  519.  
  520. (println "")
  521. (println "cdr_")
  522. (println (cdr_ lunch))
  523. ;//=> ()
  524.  
  525.  
  526. (println (value '(add1 1)))
  527. ;//=> 2
  528.  
  529. (println (value '(eq 2 1)))
  530. ;//=> false
  531.  
  532. (println (value '(eq 1 1)))
  533. ;//=> true
  534.  
  535. (println (value '(quote hello)))
  536. ;//=> hello
  537.  
  538. (println (value '((lambda (x) 1) 2)))
  539. ;//=> 1
  540.  
  541. (println (value '((lambda (x) x) 2)))
  542. ;//=> 2
  543.  
  544. (println (value '((lambda (x) (add1 x)) 2)))
  545. ;//=> 3
  546.  
  547. (println (value '(((lambda (y) (lambda (x) 1) y) 4)  3)))
  548. ;//=> 1
  549.  
  550.  
  551. (println (value '(((lambda (y) (lambda (x) x) y) 4)  3)))
  552. ;//=> 3
  553.  
  554. (println (value '(((lambda (x y) (lambda (u) (cond (u x) (t y)))) 1 '() ) nil)))
  555. ;//=> ()
  556.  
  557. (println (value '((lambda (x) ((lambda (x) (add1 x)) (add1 4))) 6)))
  558. ;//=> 6
  559.  
Success #stdin #stdout 1.69s 220224KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 

build
(a b)

new-entry
(a b)

lookup-in-entry-help
entree
nil
garlicbread

couldntfind
couldn't find wally
nil
couldn't find entree
nil

first_
a

second_
b

third_
c

lookup-in-entry
garlicbread
couldn't find entree
nil

extend-table
(((breakfast lunch) (toast sandwiches)) ((mains dessert) (beef fruit)))

lookup-in-table
steak
steak

*self-evaluating
(+ 1 1)
1

intial-table
(primitive a)

*identifier
(primitive a)

atom-to-action
#<Chapter10WhatIsTheValueOfAllThis$_STAR_self_evaluating Chapter10WhatIsTheValueOfAllThis$_STAR_self_evaluating@e66f56>
#<Chapter10WhatIsTheValueOfAllThis$_STAR_identifier Chapter10WhatIsTheValueOfAllThis$_STAR_identifier@6e4365>

text-of-quotation
helloWorld
hello

*quote
helloWorld

*lambda
(non-primitive (() (b) (println b)))

question-of
(= 1 a)

answer-of
(println true)

list-to-action
#<Unbound Unbound: #'Chapter10WhatIsTheValueOfAllThis/*application>
#<Chapter10WhatIsTheValueOfAllThis$_STAR_lambda Chapter10WhatIsTheValueOfAllThis$_STAR_lambda@1f2cea2>

expression-to-action
#<Chapter10WhatIsTheValueOfAllThis$_STAR_lambda Chapter10WhatIsTheValueOfAllThis$_STAR_lambda@1f2cea2>
#<Chapter10WhatIsTheValueOfAllThis$_STAR_identifier Chapter10WhatIsTheValueOfAllThis$_STAR_identifier@6e4365>
#<Chapter10WhatIsTheValueOfAllThis$_STAR_self_evaluating Chapter10WhatIsTheValueOfAllThis$_STAR_self_evaluating@e66f56>

table-of
(first second)
*lambda

formals-of
(third forth)
(args0)

third_
functionBody

evlis
((primitive +) 1 (primitive a))

function-of
+

arguments-of
(1 1)

primitive?
true

non-primitive?
true

add1
3

sub1
1

apply_

*application

meaning
nil
1

evcon
1

cond-lines
(((= 1 a) (println true)) (true 1))

*cond
1

value
nil

apply-primitive
true

apply-closure
(6 a b c)

cons_
#<Chapter10WhatIsTheValueOfAllThis$cons_$fn__305 Chapter10WhatIsTheValueOfAllThis$cons_$fn__305@1636e4e>

lunch
apple
apple
()

car_
apple

cdr_
()
2
false
true
hello
1
2
3
1
3
()
6
https://ideone.com/2i9zk
language:
Clojure (clojure 1.10.0)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!