fork download
copy 
  1. ; The Little Schemer in Clojure – Chapter 7 – Shadows
  2. ; This is the code behind the page here: 
  3. ; http://j...content-available-to-author-only...e.com/blog/2012/08/31/the-little-schemer-in-clojure-chapter-7-shadows/
  4.  
  5. (ns Chapter7Shadows)
  6.  
  7. ;Big idea is taking another bash at our numeric tower
  8.  
  9. (def atom?
  10.   (fn [a]
  11.     (println "atom? " a)
  12.     (not (seq? a))))
  13.  
  14. (def null?
  15.   (fn [a]
  16.     (or
  17.       (nil? a)
  18.       (= () a))))
  19.  
  20. ;we need to define number_? to handle true/false
  21. (def number_?
  22.   (fn [a]
  23.     (println "number_? " a)
  24.     (cond
  25.       (null? a) false
  26.       (number? a) true
  27.       true false)))
  28.  
  29. (println "")
  30. (println "number_?")
  31. (println (number_? 3))
  32. ;//=> true
  33. (println (number_? 'a))
  34. ;//=> false
  35.  
  36.  
  37. ; numbered is all about working out whether this S-expression is a 
  38. ; mathematical operation or just a list
  39.  
  40. ;note we also rely on a scheme and clojure primitive number? (add to list)
  41.  
  42. (def numbered?
  43.   (fn [aexp]
  44.     (println "numbered? " aexp)
  45.     (cond
  46.       (atom? aexp) (number_? aexp)
  47.       (= (first (rest aexp)) '+)
  48.          (and
  49.            (numbered? (first aexp))
  50.            (numbered? (first (rest (rest aexp)))))
  51.       (= (first (rest aexp)) '*)
  52.          (and
  53.            (numbered? (first aexp))
  54.            (numbered? (first (rest (rest aexp)))))
  55.       (= (first (rest aexp)) 'exp)
  56.          (and
  57.            (numbered? (first aexp))
  58.            (numbered? (first (rest (rest aexp)))))
  59.       true false)))
  60.  
  61. (println "")
  62. (println "numbered?")
  63. (println (numbered? '(a b c)))
  64. ;//=> false
  65. (println (numbered? '(3 + (4 * 5))))
  66. ;//=> true
  67. (println (numbered? '(3 a (4 * 5))))
  68. ;//=> false
  69.  
  70. ; refactor numbered?
  71. (def numbered?
  72.   (fn [aexp]
  73.     (cond
  74.       (atom? aexp) (number_? aexp)
  75.       true (and
  76.              (numbered? (first aexp))
  77.              (numbered? (first (rest (rest aexp))))))))
  78.  
  79. (println "")
  80. (println "numbered? refactored")
  81. (println (numbered? '(a b c)))
  82. ;//=> false
  83. (println (numbered? '(3 + (4 * 5))))
  84. ;//=> true
  85. (println (numbered? '(3 a (4 * 5))))
  86. ;//=> true 
  87.  
  88. ; This means that you need to categorise your own 'types'
  89. (println (numbered? '(3 a (4 * 5))))
  90. ; The eighth commandment - 
  91. ; Recur on all subparts that are of the same nature
  92. ; - On all sublists of a list
  93. ; - On all the subexpressions of a representation of an arithmetic expression
  94.  
  95. ;(use 'clojure.math.numeric-tower)
  96. ; we can't use this in ideone because it doesn't have the library
  97. ; note use of new primitive expt
  98.  
  99. ;before we were just checking the values
  100. ;now we're looking at the operators and running those
  101. ;note that value or eval - is at the core of the metacircular evaluator
  102.  
  103. (def value
  104.   (fn [aexp]
  105.     (cond
  106.       (number_? aexp) aexp
  107.       (= (first (rest aexp)) '+) (+ (value (first aexp)) (value (first (rest (rest aexp)))))
  108.       (= (first (rest aexp)) '*) (* (value (first aexp)) (value (first (rest (rest aexp)))))
  109.       ;(= (first (rest aexp)) 'exp) (expt (value (first aexp)) (value (first (rest (rest aexp)))))
  110.       )))
  111.  
  112. (println "")
  113. (println "value")
  114. (println (value '(1 + 1)))
  115. ;//=> 2
  116. (println (value '(2 + 2)))
  117. ;//=> 4
  118. ;(println (value '(3 exp 3)))
  119. ;//=> 27
  120. (println (value '(4 b 4)))
  121. ;//=> nil
  122.  
  123.  
  124. ;Now we're going to take the function above and move from prefix to infix - just
  125. ; to illustrate how trivial the distinction is from an implementation point of view
  126.  
  127. (def value
  128.   (fn [aexp]
  129.     (println "value " aexp)
  130.     (cond
  131.       (number_? aexp) aexp
  132.       (= (first  aexp) '+) (+ (value (rest aexp)) (value  (rest (rest aexp))))
  133.       (= (first (rest aexp)) '*) (* (value (first aexp)) (value (first (rest (rest aexp)))))
  134.       ;(= (first (rest aexp)) 'exp) (expt (value (first aexp)) (value (first (rest (rest aexp)))))
  135.       )))
  136. ; note that the book includes a deliberate incorrect implementation to 
  137.   ; illustrate a violation of the Eight Commandment
  138. (println "")
  139.  
  140. ;(println (expt 2 3))
  141.  
  142. ;(println "value prefix not infix")
  143. ;(println (value '(+ 1 1)))
  144. ;(println (value '(* 2 2)))
  145. ;(println (value '(exp 3 3)))
  146. ;(println (value '(b 4 4)))
  147. ;Not testing as deliberately broken
  148.  
  149. (def first-sub-exp
  150.   (fn [aexp]
  151.     (first (rest aexp))))
  152.  
  153. (def second-sub-exp
  154.   (fn [aexp]
  155.     (first (rest (rest aexp)))))
  156.  
  157. (def operator
  158.   (fn [aexp]
  159.     (first aexp)))
  160.  
  161. (def value
  162.   (fn [aexp]
  163.     ;(println "value " aexp)
  164.     (cond
  165.       (number_? aexp) aexp
  166.       (= (operator aexp) '+) (+ (value (first-sub-exp aexp)) (value  (second-sub-exp aexp)))
  167.       (= (operator aexp) '*) (* (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))
  168.       ;(= (operator aexp) 'exp) (expt (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))
  169.       )))
  170.  
  171. (println "")
  172. (println "value prefix not infix - using helper functions")
  173. (println (value '(+ 1 1)))
  174. ;//=> 2
  175. (println (value '(* 2 2)))
  176. ;//=> 4
  177. ;(println (value '(exp 3 3)))
  178. ;//=> 27
  179. (println (value '(b 4 4)))
  180. ;//=> nil
  181.  
  182. (println "swapping helper functions from prefix to infix notation")
  183. (def first-sub-exp
  184.   (fn [aexp]
  185.     (first  aexp)))
  186.  
  187. (def operator
  188.   (fn [aexp]
  189.     (first (rest aexp))))
  190.  
  191.  
  192. (println (value '(1 + 1)))
  193. ;//=> 2
  194. (println (value '(2 * 2)))
  195. ;//=> 4
  196. ;(println (value '(3 exp 3)))
  197. ;//=> 27
  198. (println (value '(4 b 4)))
  199.  
  200. ; Time for another Commandment - Use helper functions to abstract from representations
  201. ; Part of this is the java concept of eclipse's extract method
  202. ; Part of it is the power this gives you to change the function across the whole
  203. ; application and have it impact many parts of the system
  204.  
  205.  
  206. ; Now we're testing for null?
  207. ; Although we had to write our own helper method for this in Chapter 1
  208. ; Now as part of implementing the metacircular interpreter - we're re-implementing it in 
  209. ; terms of other functions so keep our api minimal
  210.  
  211. ;This is what we had
  212. (def null?
  213.   (fn [a]
  214.     (or
  215.       (nil? a)
  216.       (= () a))))
  217.  
  218. ;This is what they're proposing
  219. ;(def null?
  220. ;  (fn [s]
  221. ;    (and
  222. ;      (atom? s)
  223. ;      (= s '()))))
  224. ; now I think this is dumb - because something can't be an atom and a list 
  225. ; at the same time
  226.  
  227.  
  228. (println "")
  229. (println "null?")
  230. (println (null? '()))
  231. (println (null? ()))
  232.  
  233.  
  234. ; The benefit of this is that we're reusing our atom? function
  235. ; which uses (not (seq? - so push the nil? test to the seq? function
  236. ; The disadvantage is that we're more tied to the seq? function when
  237. ; we want to bootstrap the system in itself
  238.  
  239.  
  240.  
  241. ; But what's significant about this is that we're going to build up our own number
  242. ; representation out of parentheses - admittedly a strange exercise - but going to 
  243. ; prove that we can do maths in a lisp implemented in itself
  244.  
  245. ; so let's start with zero in a number system based on parentheseses
  246. (def zero_?
  247.   (fn [n]
  248.     (null? n)))
  249.  
  250. (println "")
  251. (println "zero_? - new number system")
  252. (println (zero_? '()))
  253. ;//=>true
  254. (println (zero_? 0))
  255. ;=>false
  256.  
  257. ; note that zero is ()
  258. ; now one is (())
  259. ; and two is (()())
  260.  
  261. ;now we're going to look at a representation of addition in this system
  262. (def add1
  263.   (fn [n]
  264.     (cons '() n)))
  265.  
  266.  
  267. (println "")
  268. (println "add1")
  269. (println (add1 '()))
  270. ;//=>(()) ie 1
  271. (println (add1 '(())))
  272. ;//=> (() ()) ie 2
  273.  
  274. (def sub1
  275.   (fn [n]
  276.     (rest n)))
  277. ; note that subtracting 1 from zero will remain zero
  278.  
  279. (println "")
  280. (println "sub1")
  281. (println (sub1 '(()())))
  282. ;//=>(()) ie 1
  283. (println (sub1 '(())))
  284. ;//=>() ie 0
  285. (println (sub1 '()))
  286. ;//=> () unfortunately with our implementation sub1 of zero returns zero
  287. ; doesn't seem right - always returning a single set of parentheses
  288.  
  289. (def +_
  290.   (fn [n m]
  291.     (cond
  292.       (zero_? m) n
  293.       true (add1 (+_ n (sub1 m))))))
  294.  
  295. (println "")
  296. (println "+_")
  297. (println (+_ '() '()))
  298. ;//=> ()
  299. ;//  zero plus zero is zero
  300. (println (+_ '(()) '(())))
  301. ;//=> (()()) ie 1 plus 1 is 2
  302.  
  303.  
  304. (def number_?
  305.   (fn [n]
  306.     (cond
  307.       (null? n) true
  308.       true (and
  309.              (null? (first n))
  310.              (number_? (rest n))))))
  311.  
  312. (println "")
  313. (println "number_?")
  314. (println (number_? '() ))
  315. ;//=>true
  316. (println (number_? '(()) ))
  317. ;//=>true
  318. (println (number_? '((())) ))
  319. ;//=>false
  320. (println (number_? '(()()) ))
  321. ;//=>true
  322.  
  323.  
  324.  
  325.  
  326.  
  327. (println "done")
  328.  
  329.  
Success #stdin #stdout 1.33s 220288KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
number_?
number_?  3
true
number_?  a
false

numbered?
numbered?  (a b c)
atom?  (a b c)
false
numbered?  (3 + (4 * 5))
atom?  (3 + (4 * 5))
numbered?  3
atom?  3
number_?  3
numbered?  (4 * 5)
atom?  (4 * 5)
numbered?  4
atom?  4
number_?  4
numbered?  5
atom?  5
number_?  5
true
numbered?  (3 a (4 * 5))
atom?  (3 a (4 * 5))
false

numbered? refactored
atom?  (a b c)
atom?  a
number_?  a
false
atom?  (3 + (4 * 5))
atom?  3
number_?  3
atom?  (4 * 5)
atom?  4
number_?  4
atom?  5
number_?  5
true
atom?  (3 a (4 * 5))
atom?  3
number_?  3
atom?  (4 * 5)
atom?  4
number_?  4
atom?  5
number_?  5
true
atom?  (3 a (4 * 5))
atom?  3
number_?  3
atom?  (4 * 5)
atom?  4
number_?  4
atom?  5
number_?  5
true

value
number_?  (1 + 1)
number_?  1
number_?  1
2
number_?  (2 + 2)
number_?  2
number_?  2
4
number_?  (4 b 4)
nil


value prefix not infix - using helper functions
number_?  (+ 1 1)
number_?  1
number_?  1
2
number_?  (* 2 2)
number_?  2
number_?  2
4
number_?  (b 4 4)
nil
swapping helper functions from prefix to infix notation
number_?  (1 + 1)
number_?  1
number_?  1
2
number_?  (2 * 2)
number_?  2
number_?  2
4
number_?  (4 b 4)
nil

null?
true
true

zero_? - new number system
true
false

add1
(())
(() ())

sub1
(())
()
()

+_
()
(() ())

number_?
true
true
false
true
done
https://ideone.com/dmke1
language:
Clojure (clojure 1.10.0)
created:
11 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!