├── 02-do-it-again.ss ├── 09-and-again.ss ├── 01-toys.ss ├── 06-shadows.ss ├── 03-cons-the-magnificent.ss ├── 10-value-of-all-of-this.ss ├── 07-friends-and-relations.ss ├── 04-numbers-games.ss ├── 05-full-of-stars.ss ├── 08-lambda-the-ultimate.ss └── readme.txt /02-do-it-again.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 2 of The Little Schemer: 3 | ; Do It, Do It Again, and Again, and Again ... 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 | ; We need to define atom? for Scheme as it's not a primitive ; 13 | ; ; 14 | (define atom? ; 15 | (lambda (x) ; 16 | (and (not (pair? x)) (not (null? x))))) ; 17 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 18 | 19 | ; lat? function finds if all the elements in the list are atoms 20 | ; (lat stands for list of atoms) 21 | ; 22 | (define lat? 23 | (lambda (l) 24 | (cond 25 | ((null? l) #t) 26 | ((atom? (car l)) (lat? (cdr l))) 27 | (else #f)))) 28 | 29 | ; Examples of lats: 30 | ; 31 | (lat? '(Jack Sprat could eat no chicken fat)) 32 | (lat? '()) 33 | (lat? '(bacon and eggs)) 34 | 35 | ; Examples of not-lats: 36 | ; 37 | (lat? '((Jack) Sprat could eat no chicken fat)) ; not-lat because (car l) is a list 38 | (lat? '(Jack (Sprat could) eat no chicken fat)) ; not-lat because l contains a list 39 | (lat? '(bacon (and eggs))) ; not-lat because '(and eggs) is a list 40 | 41 | ; Examples of or: 42 | ; 43 | (or (null? '()) (atom? '(d e f g))) ; true 44 | (or (null? '(a b c)) (null? '())) ; true 45 | (or (null? '(a b c)) (null? '(atom))) ; false 46 | 47 | ; member? function determines if an element is in a lat (list of atoms) 48 | ; 49 | (define member? 50 | (lambda (a lat) 51 | (cond 52 | ((null? lat) #f) 53 | (else (or (eq? (car lat) a) 54 | (member? a (cdr lat))))))) 55 | 56 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 57 | ; ; 58 | ; The first commandment (preliminary) ; 59 | ; ; 60 | ; Always ask /null?/ as the first question in expressing any function. ; 61 | ; ; 62 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 63 | 64 | ; Examples of member? succeeding 65 | ; 66 | (member? 'meat '(mashed potatoes and meat gravy)) 67 | (member? 'meat '(potatoes and meat gravy)) 68 | (member? 'meat '(and meat gravy)) 69 | (member? 'meat '(meat gravy)) 70 | 71 | ; Examples of member? failing 72 | (member? 'liver '(bagels and lox)) 73 | (member? 'liver '()) 74 | 75 | 76 | 77 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 78 | ; ; 79 | ; This space is for doodling ; 80 | ; ; 81 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 82 | 83 | 84 | 85 | ; 86 | ; Go get yourself this wonderful book and have fun with these examples! 87 | ; 88 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 89 | ; 90 | ; Sincerely, 91 | ; Peteris Krumins 92 | ; http://www.catonmat.net 93 | ; 94 | 95 | -------------------------------------------------------------------------------- /09-and-again.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 8 of The Little Schemer: 3 | ; ...and Again, and Again, and Again, ... 4 | ; 5 | ; Code examples assemled by Jinpu Hu (hujinpu@gmail.com). 6 | ; His blog is at http://hujinpu.com -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | 12 | ; The pick function returns the n-th element in a lat 13 | ; 14 | (define pick 15 | (lambda (n lat) 16 | (cond 17 | ((zero? (sub1 n)) (car lat)) 18 | (else 19 | (pick (sub1 n) (cdr lat)))))) 20 | 21 | ; Functions like looking are called partial functions. 22 | ; 23 | (define looking 24 | (lambda (a lat) 25 | (keep-looking a (pick 1 lat) lat))) 26 | 27 | ; Example of looking 28 | ; 29 | (looking 'caviar '(6 2 4 caviar 5 7 3)) ; #t 30 | (looking 'caviar '(6 2 grits caviar 5 7 3)) ; #f 31 | 32 | ; It does not recur on a part of lat. 33 | ; It is truly unnatural. 34 | ; 35 | (define keep-looking 36 | (lambda (a sorn lat) 37 | (cond 38 | ((number? sorn) 39 | (keep-looking a (pick sorn lat) lat)) 40 | (else (eq? sorn a ))))) 41 | 42 | ; It is the most partial function. 43 | ; 44 | (define eternity 45 | (lambda (x) 46 | (eternity x))) 47 | 48 | ; Helper functions for working with pairs 49 | ; 50 | (define first 51 | (lambda (p) 52 | (car p))) 53 | 54 | (define second 55 | (lambda (p) 56 | (car (cdr p)))) 57 | 58 | (define build 59 | (lambda (s1 s2) 60 | (cons s1 (cons s2 '())))) 61 | 62 | ; The function shift takes a pair whose first component is a pair 63 | ; and builds a pair by shifting the second part of the first component 64 | ; into the second component 65 | ; 66 | (define shift 67 | (lambda (pair) 68 | (build (first (first pair)) 69 | (build (second (first pair)) 70 | (second pair))))) 71 | 72 | ; Example of shift 73 | ; 74 | (shift '((a b) c)) ; '(a (b c)) 75 | (shift '((a b) (c d))) ; '(a (b (c d))) 76 | 77 | ; The a-pair? function determines if it's a pair 78 | ; 79 | (define a-pair? 80 | (lambda (x) 81 | (cond 82 | ((atom? x) #f) 83 | ((null? x) #f) 84 | ((null? (cdr x)) #f) 85 | ((null? (cdr (cdr x))) #t) 86 | (else #f)))) 87 | 88 | ; We first need to define atom? for Scheme as it's not a primitive 89 | ; 90 | (define atom? 91 | (lambda (x) 92 | (and (not (pair? x)) (not (null? x))))) 93 | 94 | ; align is not a partial function, because it yields a value for every argument. 95 | ; 96 | (define align 97 | (lambda (pora) 98 | (cond 99 | ((atom? pora) pora) 100 | ((a-pair? (first pora)) 101 | (align (shift pora))) 102 | (else (build (first pora) 103 | (align (second pora))))))) 104 | 105 | ; counts the number of atoms in align's arguments 106 | ; 107 | (define length* 108 | (lambda (pora) 109 | (cond 110 | ((atom? pora) 1) 111 | (else 112 | (+ (length* (first pora)) 113 | (length* (second pora))))))) 114 | 115 | (define weight* 116 | (lambda (pora) 117 | (cond 118 | ((atom? pora) 1) 119 | (else 120 | (+ (* (weight* (first pora)) 2) 121 | (weight* (second pora))))))) 122 | 123 | ; Example of weight* 124 | ; 125 | (weight* '((a b) c)) ; 7 126 | (weight* '(a (b c)) ; 5 127 | 128 | ; Let's simplify revrel by using inventing revpair that reverses a pair 129 | ; 130 | (define revpair 131 | (lambda (p) 132 | (build (second p) (first p)))) 133 | 134 | (define shuffle 135 | (lambda (pora) 136 | (cond 137 | ((atom? pora) pora) 138 | ((a-pair? (first pora)) 139 | (shuffle (revpair pora))) 140 | (else 141 | (build (first pora) 142 | (shuffle (second pora))))))) 143 | 144 | ; Example of shuffle 145 | ; 146 | (shuffle '(a (b c))) ; '(a (b c)) 147 | (shuffle '(a b)) ; '(a b) 148 | (shuffle '((a b) (c d))) ; infinite swap pora Ctrl + c to break and input q to exit 149 | 150 | ; The one? function is true when n=1 151 | ; 152 | (define one? 153 | (lambda (n) (= n 1))) 154 | 155 | ; not total function 156 | (define C 157 | (lambda (n) 158 | (cond 159 | ((one? n) 1) 160 | (else 161 | (cond 162 | ((even? n) (C (/ n 2))) 163 | (else 164 | (C (add1 (* 3 n))))))))) 165 | 166 | (define A 167 | (lambda (n m) 168 | (cond 169 | ((zero? n) (add1 m)) 170 | ((zero? m) (A (sub1 n) 1)) 171 | (else 172 | (A (sub1 n) 173 | (A n (sub1 m))))))) 174 | 175 | ; Example of A 176 | (A 1 0) ; 2 177 | (A 1 1) ; 3 178 | (A 2 2) ; 7 179 | 180 | ; length0 181 | ; 182 | (lambda (l) 183 | (cond 184 | ((null? l) 0) 185 | (else 186 | (add1 (eternity (cdr l)))))) 187 | 188 | ; length<=1 189 | ; 190 | (lambda (l) 191 | (cond 192 | ((null? l) 0) 193 | (else 194 | (add1 195 | ((lambda(l) 196 | (cond 197 | ((null? l) 0) 198 | (else 199 | (add1 (eternity (cdr l)))))) 200 | (cdr l)))))) 201 | 202 | ; All these programs contain a function that looks like length. 203 | ; Perhaps we should abstract out this function. 204 | 205 | ; rewrite length0 206 | ; 207 | ((lambda (length) 208 | (lambda (l) 209 | (cond 210 | ((null? l) 0) 211 | (else (add1 (length (cdr l))))))) 212 | eternity) 213 | 214 | ; rewrite length<=1 215 | ; 216 | ((lambda (f) 217 | (lambda (l) 218 | (cond 219 | ((null? l) 0) 220 | (else (add1 (f (cdr l))))))) 221 | ((lambda (g) 222 | (lambda (l) 223 | (cond 224 | ((null? l) 0) 225 | (else (add1 (g (cdr l))))))) 226 | eternity)) 227 | 228 | ; make length 229 | ; 230 | (lambda (mk-length) 231 | (mk-length eternity)) 232 | 233 | ; rewrite length<=1 234 | ((lambda (mk-length) 235 | (mk-length mk-length)) 236 | (lambda (mk-length) 237 | (lambda (l) 238 | (cond 239 | ((null? l) 0) 240 | (else 241 | (add1 242 | ((mk-length eternity) (cdr l)))))))) 243 | 244 | ; It's (length '(1 2 3 4 5)) 245 | ; 246 | (((lambda (mk-length) 247 | (mk-length mk-length)) 248 | (lambda (mk-length) 249 | (lambda (l) 250 | (cond 251 | ((null? l) 0) 252 | (else 253 | (add1 254 | ((mk-length mk-length) (cdr l)))))))) 255 | '(1 2 3 4 5)) 256 | 257 | ; 5 258 | 259 | 260 | ((lambda (mk-length) 261 | (mk-length mk-length)) 262 | (lambda (mk-length) 263 | ((lambda (length) 264 | (lambda (l) 265 | (cond 266 | ((null? l) 0) 267 | (else 268 | (add1 (length (cdr l))))))) 269 | (lambda (x) 270 | ((mk-length mk-length) x))))) 271 | 272 | ; move out length function 273 | ; 274 | ((lambda (le) 275 | ((lambda (mk-length) 276 | (mk-length mk-length)) 277 | (lambda (mk-length) 278 | (le (lambda (x) 279 | ((mk-length mk-length) x)))))) 280 | (lambda (length) 281 | (lambda (l) 282 | (cond 283 | ((null? l) 0) 284 | (else (add1 (length (cdr l)))))))) 285 | 286 | ; Y 287 | ; 288 | (lambda (le) 289 | ((lambda (mk-length) 290 | (mk-length mk-length)) 291 | (lambda (mk-length) 292 | (le (lambda (x) 293 | ((mk-length mk-length) x)))))) 294 | 295 | ; it is called the applicative-order Y combinator. 296 | ; 297 | (define Y 298 | (lambda (le) 299 | ((lambda (f) (f f)) 300 | (lambda (f) 301 | (le (lambda (x) ((f f) x))))))) -------------------------------------------------------------------------------- /01-toys.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 1 of The Little Schemer: 3 | ; Toys 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; Examples of atoms: 12 | ; 13 | 'atom 14 | (quote atom) 15 | 'turkey 16 | 1492 17 | '*abc$ 18 | (quote *abc$) 19 | 20 | ; Examples of lists and s-expressions 21 | ; 22 | '(atom) 23 | (quote (atom)) 24 | '(atom turkey or) 25 | '((atom turkey) or) 26 | 'xyz 27 | '(x y z) 28 | '((x y z)) 29 | '(how are you doing so far) 30 | '(((how) are) ((you) (doing so)) far) 31 | '() 32 | '(() () () ()) 33 | 34 | ; Example of not-lists 35 | ; 36 | '(atom turkey) 'or ; because it's two separate s-expressions 37 | 38 | ; Example of not-atoms 39 | ; 40 | '() ; because it's a list 41 | 42 | ; Examples of car 43 | ; 44 | (car '(a b c)) ; 'a 45 | (car '((a b c) x y z)) ; '(a b c) 46 | 47 | ; Examples of not-applicable car 48 | ; 49 | ; (car 'hotdog) ; not-applicable because 'hotdog is not a list 50 | ; (car '()) ; not-applicable because '() is an empty list 51 | 52 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 53 | ; The law of car: ; 54 | ; ; 55 | ; The primitive /car/ is defined only for non-empty lists. ; 56 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 57 | 58 | ; More examples of car 59 | ; 60 | (car '(((hotdogs)) (and) (pickle) relish)) ; '((hotdogs)) 61 | (car (car '(((hotdogs)) (and)))) ; '(hotdogs) 62 | 63 | ; Examples of cdr 64 | ; 65 | (cdr '(a b c)) ; '(b c) 66 | (cdr '((a b c) x y z)) ; '(x y z) 67 | (cdr '(hamburger)) ; '() 68 | (cdr '((x) t r)) ; '(t r) 69 | 70 | ; Examples of not-applicable cdr 71 | ; 72 | ; (cdr 'hotdogs) ; not-applicable because 'hotdogs is not a list 73 | ; (cdr '()) ; not-applicable because '() is an empty list 74 | 75 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 76 | ; The law of cdr: ; 77 | ; ; 78 | ; The primitive /cdr/ is defined only for non-empty lists. ; 79 | ; The /cdr/ of any non-empty list is always another list. ; 80 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 81 | 82 | ; Examples of car and cdr 83 | ; 84 | (car (cdr '((b) (x y) ((c))))) ; '(x y) 85 | (cdr (cdr '((b) (x y) ((c))))) ; '(((c))) 86 | 87 | ; Examples of cons 88 | ; 89 | (cons 'peanut '(butter and jelly)) ; '(peanut butter and jelly) 90 | (cons '(banana and) '(peanut butter and jelly)) ; '((banana and) peanut butter and jelly) 91 | (cons '((help) this) '(is very ((hard) to learn))) ; '(((help) this) is very ((hard) to learn)) 92 | (cons '(a b (c)) '()) ; '((a b (c))) 93 | (cons 'a '()) ; '(a) 94 | 95 | ; Examples of not-applicable cons 96 | ; 97 | ; (cons '((a b c)) 'b) ; not-applicable because 'b is not a list 98 | ; (cons 'a 'b) ; not-applicable because 'b is not a list 99 | 100 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 101 | ; The law of cons ; 102 | ; ; 103 | ; The primitive /cons/ takes two arguments. ; 104 | ; The second argument to /cons/ must be a list. ; 105 | ; The result is a list. ; 106 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 107 | 108 | ; Examples of cons, car and cdr 109 | ; 110 | (cons 'a (car '((b) c d))) ; (a b) 111 | (cons 'a (cdr '((b) c d))) ; (a c d) 112 | 113 | ; Example of the null-list 114 | ; 115 | '() 116 | 117 | ; Examples of null? 118 | ; 119 | (null? '()) ; true 120 | (null? '(a b c)) ; false 121 | 122 | ; Example of not-applicable null? 123 | ; 124 | ; (null? 'spaghetti) ; not-applicable because 'spaghetti is not a list 125 | 126 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 127 | ; The law of null? ; 128 | ; ; 129 | ; The primitive /null?/ is defined only for lists ; 130 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 131 | 132 | ; We first need to define atom? for Scheme as it's not a primitive 133 | ; 134 | (define atom? 135 | (lambda (x) 136 | (and (not (pair? x)) (not (null? x))))) 137 | 138 | ; Examples of atom? 139 | ; 140 | (atom? 'Harry) ; true 141 | (atom? '(Harry had a heap of apples)) ; false 142 | 143 | ; Examples of atom?, car and cdr 144 | ; 145 | (atom? (car '(Harry had a heap of apples))) ; true 146 | (atom? (cdr '(Harry had a heap of apples))) ; false 147 | (atom? (cdr '(Harry))) ; false 148 | (atom? (car (cdr '(swing low sweet cherry oat)))) ; true 149 | (atom? (car (cdr '(swing (low sweet) cherry oat)))) ; false 150 | 151 | ; Examples of eq? 152 | ; 153 | (eq? 'Harry 'Harry) ; true 154 | (eq? 'margarine 'butter) ; false 155 | 156 | ; Example of not-applicable eq? 157 | ; 158 | ; (eq? '() '(strawberry)) ; not-applicable because eq? works only on atoms 159 | ; (eq? 5 6) ; not-applicable because eq? works only on non-numeric atoms 160 | 161 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 162 | ; The law of eq? ; 163 | ; ; 164 | ; The primitive /eq?/ takes two arguments. ; 165 | ; Each must be a non-numeric atom. ; 166 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 167 | 168 | ; Examples of eq?, car and cdr 169 | ; 170 | (eq? (car '(Mary had a little lamb chop)) 'Mary) ; true 171 | (eq? (car '(beans beans)) (car (cdr '(beans beans)))) ; true 172 | 173 | 174 | ; Examples of not-applicable eq?, car and cdr 175 | ; 176 | ; (eq? (cdr '(soured milk)) 'milk) ; not-applicable because (cdr '(...)) is a list 177 | 178 | 179 | 180 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 181 | ; ; 182 | ; This space reserved for ; 183 | ; JELLY STAINS! ; 184 | ; ; 185 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 186 | 187 | 188 | 189 | ; 190 | ; Go get yourself this wonderful book and have fun with these examples! 191 | ; 192 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 193 | ; 194 | ; Sincerely, 195 | ; Peteris Krumins 196 | ; http://www.catonmat.net 197 | ; 198 | 199 | -------------------------------------------------------------------------------- /06-shadows.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 6 of The Little Schemer: 3 | ; Shadows 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; The atom? primitive 12 | ; 13 | (define atom? 14 | (lambda (x) 15 | (and (not (pair? x)) (not (null? x))))) 16 | 17 | ; The numbered? function determines whether a representation of an arithmetic 18 | ; expression contains only numbers besides the o+, ox and o^ (for +, * and exp). 19 | ; 20 | (define numbered? 21 | (lambda (aexp) 22 | (cond 23 | ((atom? aexp) (number? aexp)) 24 | ((eq? (car (cdr aexp)) 'o+) 25 | (and (numbered? (car aexp)) 26 | (numbered? (car (cdr (cdr aexp)))))) 27 | ((eq? (car (cdr aexp)) 'ox) 28 | (and (numbered? (car aexp)) 29 | (numbered? (car (cdr (cdr aexp)))))) 30 | ((eq? (car (cdr aexp)) 'o^) 31 | (and (numbered? (car aexp)) 32 | (numbered? (car (cdr (cdr aexp)))))) 33 | (else #f)))) 34 | 35 | ; Examples of numbered? 36 | ; 37 | (numbered? '5) ; #t 38 | (numbered? '(5 o+ 5)) ; #t 39 | (numbered? '(5 o+ a)) ; #f 40 | (numbered? '(5 ox (3 o^ 2))) ; #t 41 | (numbered? '(5 ox (3 'foo 2))) ; #f 42 | (numbered? '((5 o+ 2) ox (3 o^ 2))) ; #t 43 | 44 | ; Assuming aexp is a numeric expression, numbered? can be simplified 45 | ; 46 | (define numbered? 47 | (lambda (aexp) 48 | (cond 49 | ((atom? aexp) (number? aexp)) 50 | (else 51 | (and (numbered? (car aexp)) 52 | (numbered? (car (cdr (cdr aexp))))))))) 53 | 54 | ; Tests of numbered? 55 | ; 56 | (numbered? '5) ; #t 57 | (numbered? '(5 o+ 5)) ; #t 58 | (numbered? '(5 ox (3 o^ 2))) ; #t 59 | (numbered? '((5 o+ 2) ox (3 o^ 2))) ; #t 60 | 61 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 62 | ; ; 63 | ; The seventh commandment ; 64 | ; ; 65 | ; Recur on the subparts that are of the same nature: ; 66 | ; * On the sublists of a list. ; 67 | ; * On the subexpressions of an arithmetic expression. ; 68 | ; ; 69 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 70 | 71 | ; The value function determines the value of an arithmetic expression 72 | ; 73 | (define value 74 | (lambda (nexp) 75 | (cond 76 | ((atom? nexp) nexp) 77 | ((eq? (car (cdr nexp)) 'o+) 78 | (+ (value (car nexp)) 79 | (value (car (cdr (cdr nexp)))))) 80 | ((eq? (car (cdr nexp)) 'o*) 81 | (* (value (car nexp)) 82 | (value (car (cdr (cdr nexp)))))) 83 | ((eq? (car (cdr nexp)) 'o^) 84 | (expt (value (car nexp)) 85 | (value (car (cdr (cdr nexp)))))) 86 | (else #f)))) 87 | 88 | ; Examples of value 89 | ; 90 | (value 13) ; 13 91 | (value '(1 o+ 3)) ; 4 92 | (value '(1 o+ (3 o^ 4))) ; 82 93 | 94 | ; The value function for prefix notation 95 | ; 96 | (define value-prefix 97 | (lambda (nexp) 98 | (cond 99 | ((atom? nexp) nexp) 100 | ((eq? (car nexp) 'o+) 101 | (+ (value-prefix (car (cdr nexp))) 102 | (value-prefix (car (cdr (cdr nexp)))))) 103 | ((eq? (car nexp) 'o*) 104 | (* (value-prefix (car (cdr nexp))) 105 | (value-prefix (car (cdr (cdr nexp)))))) 106 | ((eq? (car nexp) 'o^) 107 | (expt (value-prefix (car (cdr nexp))) 108 | (value-prefix (car (cdr (cdr nexp)))))) 109 | (else #f)))) 110 | 111 | ; Examples of value-prefix 112 | ; 113 | (value-prefix 13) ; 13 114 | (value-prefix '(o+ 3 4)) ; 7 115 | (value-prefix '(o+ 1 (o^ 3 4))) ; 82 116 | 117 | ; It's best to invent 1st-sub-exp and 2nd-sub-exp functions 118 | ; instead of writing (car (cdr (cdr nexp))), etc. 119 | ; These are for prefix notation. 120 | ; 121 | (define 1st-sub-exp 122 | (lambda (aexp) 123 | (car (cdr aexp)))) 124 | 125 | (define 2nd-sub-exp 126 | (lambda (aexp) 127 | (car (cdr (cdr aexp))))) 128 | 129 | ; It's also best to invent operator function, 130 | ; instead of writing (car nexp), etc. 131 | ; This is for prefix notation 132 | ; 133 | (define operator 134 | (lambda (aexp) 135 | (car aexp))) 136 | 137 | ; The new value function that uses helper functions 138 | ; 139 | (define value-prefix-helper 140 | (lambda (nexp) 141 | (cond 142 | ((atom? nexp) nexp) 143 | ((eq? (operator nexp) 'o+) 144 | (+ (value-prefix (1st-sub-exp nexp)) 145 | (value-prefix (2nd-sub-exp nexp)))) 146 | ((eq? (car nexp) 'o*) 147 | (* (value-prefix (1st-sub-exp nexp)) 148 | (value-prefix (2nd-sub-exp nexp)))) 149 | ((eq? (car nexp) 'o^) 150 | (expt (value-prefix (1st-sub-exp nexp)) 151 | (value-prefix (2nd-sub-exp nexp)))) 152 | (else #f)))) 153 | 154 | ; Examples of value-prefix-helper 155 | ; 156 | (value-prefix-helper 13) ; 13 157 | (value-prefix-helper '(o+ 3 4)) ; 7 158 | (value-prefix-helper '(o+ 1 (o^ 3 4))) ; 82 159 | 160 | ; Redefine helper functions for infix notation 161 | ; 162 | (define 1st-sub-exp 163 | (lambda (aexp) 164 | (car aexp))) 165 | 166 | (define 2nd-sub-exp 167 | (lambda (aexp) 168 | (car (cdr (cdr aexp))))) 169 | 170 | (define operator 171 | (lambda (aexp) 172 | (car (cdr aexp)))) 173 | 174 | ; Examples of value-prefix-helper of infix notation expressions 175 | ; 176 | (value-prefix 13) ; 13 177 | (value-prefix '(o+ 3 4)) ; 7 178 | (value-prefix '(o+ 1 (o^ 3 4))) ; 82 179 | 180 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 181 | ; ; 182 | ; The eighth commandment ; 183 | ; ; 184 | ; Use help functions to abstract from representations. ; 185 | ; ; 186 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 187 | 188 | ; A different number representation: 189 | ; () for zero, (()) for one, (() ()) for two, (() () ()) for three, etc. 190 | ; 191 | 192 | ; sero? just like zero? 193 | ; 194 | (define sero? 195 | (lambda (n) 196 | (null? n))) 197 | 198 | ; edd1 just like add1 199 | ; 200 | (define edd1 201 | (lambda (n) 202 | (cons '() n))) 203 | 204 | ; zub1 just like sub1 205 | ; 206 | (define zub1 207 | (lambda (n) 208 | (cdr n))) 209 | 210 | ; .+ just like o+ 211 | ; 212 | (define .+ 213 | (lambda (n m) 214 | (cond 215 | ((sero? m) n) 216 | (else 217 | (edd1 (.+ n (zub1 m))))))) 218 | 219 | ; Example of .+ 220 | ; 221 | (.+ '(()) '(() ())) ; (+ 1 2) 222 | ;==> '(() () ()) 223 | 224 | ; tat? just like lat? 225 | ; 226 | (define tat? 227 | (lambda (l) 228 | (cond 229 | ((null? l) #t) 230 | ((atom? (car l)) 231 | (tat? (cdr l))) 232 | (else #f)))) 233 | 234 | ; But does tat? work 235 | 236 | (tat? '((()) (()()) (()()()))) ; (lat? '(1 2 3)) 237 | ; ==> #f 238 | 239 | ; Beware of shadows. 240 | 241 | ; 242 | ; Go get yourself this wonderful book and have fun with these examples! 243 | ; 244 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 245 | ; 246 | ; Sincerely, 247 | ; Peteris Krumins 248 | ; http://www.catonmat.net 249 | ; 250 | 251 | -------------------------------------------------------------------------------- /03-cons-the-magnificent.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 3 of The Little Schemer: 3 | ; Cons the Magnificent 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; The rember function removes the first occurance of the given atom from the 12 | ; given list. 13 | ; 14 | (define rember 15 | (lambda (a lat) 16 | (cond 17 | ((null? lat) '()) 18 | ((eq? (car lat) a) (cdr lat)) 19 | (else (cons (car lat) 20 | (rember a (cdr lat))))))) 21 | 22 | ; Examples of rember function 23 | ; 24 | (rember 'mint '(lamb chops and mint flavored mint jelly)) ; '(lamb chops and flavored mint jelly) 25 | (rember 'toast '(bacon lettuce and tomato)) ; '(bacon lettuce and tomato) 26 | (rember 'cup '(coffee cup tea cup and hick cup)) ; '(coffee tea cup and hick cup) 27 | 28 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 | ; ; 30 | ; The second commandment ; 31 | ; ; 32 | ; Use /cons/ to build lists. ; 33 | ; ; 34 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 35 | 36 | ; The firsts function builds a list of first s-expressions 37 | ; 38 | (define firsts 39 | (lambda (l) 40 | (cond 41 | ((null? l) '()) 42 | (else 43 | (cons (car (car l)) (firsts (cdr l))))))) 44 | 45 | ; Examples of firsts 46 | ; 47 | (firsts '((apple peach pumpkin) 48 | (plum pear cherry) 49 | (grape raisin pea) 50 | (bean carrot eggplant))) ; '(apple plum grape bean) 51 | 52 | (firsts '((a b) (c d) (e f))) ; '(a c e) 53 | (firsts '((five plums) (four) (eleven green oranges))) ; '(five four eleven) 54 | (firsts '(((five plums) four) 55 | (eleven green oranges) 56 | ((no) more))) ; '((five plums) eleven (no)) 57 | 58 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 59 | ; ; 60 | ; The third commandment ; 61 | ; ; 62 | ; When building lists, describe the first typical element, and then /cons/ ; 63 | ; it onto the natural recursion. ; 64 | ; ; 65 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 66 | 67 | ; The insertR function inserts the element new to the right of the first 68 | ; occurence of element old in the list lat 69 | ; 70 | (define insertR 71 | (lambda (new old lat) 72 | (cond 73 | ((null? lat) '()) 74 | ((eq? (car lat) old) 75 | (cons old (cons new (cdr lat)))) 76 | (else 77 | (cons (car lat) (insertR new old (cdr lat))))))) 78 | 79 | ; Examples of insertR 80 | ; 81 | (insertR 82 | 'topping 'fudge 83 | '(ice cream with fudge for dessert)) ; '(ice cream with fudge topping for dessert) 84 | 85 | (insertR 86 | 'jalapeno 87 | 'and 88 | '(tacos tamales and salsa)) ; '(tacos tamales and jalapeno salsa) 89 | 90 | (insertR 91 | 'e 92 | 'd 93 | '(a b c d f g d h)) ; '(a b c d e f g d h) 94 | 95 | ; The insertL function inserts the element new to the left of the first 96 | ; occurrence of element old in the list lat 97 | ; 98 | (define insertL 99 | (lambda (new old lat) 100 | (cond 101 | ((null? lat) '()) 102 | ((eq? (car lat) old) 103 | (cons new (cons old (cdr lat)))) 104 | (else 105 | (cons (car lat) (insertL new old (cdr lat))))))) 106 | 107 | ; Example of insertL 108 | ; 109 | (insertL 110 | 'd 111 | 'e 112 | '(a b c e g d h)) ; '(a b c d e g d h) 113 | 114 | ; The subst function substitutes the first occurence of element old with new 115 | ; in the list lat 116 | ; 117 | (define subst 118 | (lambda (new old lat) 119 | (cond 120 | ((null? lat) '()) 121 | ((eq? (car lat) old) 122 | (cons new (cdr lat))) 123 | (else 124 | (cons (car lat) (subst new old (cdr lat))))))) 125 | 126 | ; Example of subst 127 | ; 128 | (subst 129 | 'topping 130 | 'fudge 131 | '(ice cream with fudge for dessert)) ; '(ice cream with topping for dessert) 132 | 133 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 134 | ; ; 135 | ; Go cons a piece of cake onto your mouth. ; 136 | ; ; 137 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 138 | 139 | ; The subst2 function substitutes the first occurence of elements o1 or o2 140 | ; with new in the list lat 141 | ; 142 | (define subst2 143 | (lambda (new o1 o2 lat) 144 | (cond 145 | ((null? lat) '()) 146 | ((or (eq? (car lat) o1) (eq? (car lat) o2)) 147 | (cons new (cdr lat))) 148 | (else 149 | (cons (car lat) (subst new o1 o2 (cdr lat))))))) 150 | 151 | ; Example of subst2 152 | ; 153 | (subst2 154 | 'vanilla 155 | 'chocolate 156 | 'banana 157 | '(banana ice cream with chocolate topping)) ; '(vanilla ice cream with chocolate topping) 158 | 159 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 160 | ; ; 161 | ; If you got the last function, go and repeat the cake-consing. ; 162 | ; ; 163 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 164 | 165 | ; The multirember function removes all occurances of a from lat 166 | ; 167 | (define multirember 168 | (lambda (a lat) 169 | (cond 170 | ((null? lat) '()) 171 | ((eq? (car lat) a) 172 | (multirember a (cdr lat))) 173 | (else 174 | (cons (car lat) (multirember a (cdr lat))))))) 175 | 176 | ; Example of multirember 177 | ; 178 | (multirember 179 | 'cup 180 | '(coffee cup tea cup and hick cup)) ; '(coffee tea and hick) 181 | 182 | ; The multiinsertR function inserts the element new to the right of all 183 | ; occurences of element old in the list lat 184 | ; 185 | (define multiinsertR 186 | (lambda (new old lat) 187 | (cond 188 | ((null? lat) '()) 189 | ((eq? (car lat) old) 190 | (cons old (cons new (multiinsertR new old (cdr lat))))) 191 | (else 192 | (cons (car lat) (multiinsertR new old (cdr lat))))))) 193 | 194 | ; Example of multiinsertR 195 | ; 196 | (multiinsertR 197 | 'x 198 | 'a 199 | '(a b c d e a a b)) ; (a x b c d e a x a x b) 200 | 201 | 202 | ; The multiinsertL function inserts the element new to the left of all 203 | ; occurences of element old in the list lat 204 | ; 205 | (define multiinsertL 206 | (lambda (new old lat) 207 | (cond 208 | ((null? lat) '()) 209 | ((eq? (car lat) old) 210 | (cons new (cons old (multiinsertL new old (cdr lat))))) 211 | (else 212 | (cons (car lat) (multiinsertL new old (cdr lat))))))) 213 | 214 | ; Example of multiinsertL 215 | ; 216 | (multiinsertL 217 | 'x 218 | 'a 219 | '(a b c d e a a b)) ; (x a b c d e x a x a b) 220 | 221 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 222 | ; ; 223 | ; The fourth commandment (preliminary) ; 224 | ; ; 225 | ; Always change at least one argument while recurring. It must be changed to ; 226 | ; be closer to termination. The changing argument must be tested in the ; 227 | ; termination condition: when using cdr, test the termination with null?. ; 228 | ; ; 229 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 230 | 231 | ; The multisubst function substitutes all occurence of element old with new 232 | ; in the list lat 233 | ; 234 | (define multisubst 235 | (lambda (new old lat) 236 | (cond 237 | ((null? lat) '()) 238 | ((eq? (car lat) old) 239 | (cons new (multisubst new old (cdr lat)))) 240 | (else 241 | (cons (car lat) (multisubst new old (cdr lat))))))) 242 | 243 | ; Example of multisubst 244 | ; 245 | (multisubst 246 | 'x 247 | 'a 248 | '(a b c d e a a b)) ; (x b c d e x x b) 249 | 250 | ; 251 | ; Go get yourself this wonderful book and have fun with these examples! 252 | ; 253 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 254 | ; 255 | ; Sincerely, 256 | ; Peteris Krumins 257 | ; http://www.catonmat.net 258 | ; 259 | 260 | -------------------------------------------------------------------------------- /10-value-of-all-of-this.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 10 of The Little Schemer: 3 | ; What Is the Value of All This? 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; We'll need atom? 12 | ; 13 | (define atom? 14 | (lambda (x) 15 | (and (not (pair? x)) (not (null? x))))) 16 | 17 | ; An entry is a pair of lists whose first list is a set. The two lists must be 18 | ; of equal length. 19 | ; Here are some entry examples. 20 | ; 21 | '((appetizer entree bevarage) 22 | (pate boeuf vin)) 23 | '((appetizer entree bevarage) 24 | (beer beer beer)) 25 | '((bevarage dessert) 26 | ((food is) (number one with us))) 27 | 28 | ; Let's build entries with build from chapter 7 (07-friends-and-relations.ss) 29 | ; 30 | (define build 31 | (lambda (s1 s2) 32 | (cons s1 (cons s2 '())))) 33 | 34 | (define new-entry build) 35 | 36 | ; Test it out and build the example entries above 37 | ; 38 | (build '(appetizer entree bevarage) 39 | '(pate boeuf vin)) 40 | (build '(appetizer entree bevarage) 41 | '(beer beer beer)) 42 | (build '(bevarage dessert) 43 | '((food is) (number one with us))) 44 | 45 | ; We'll need first and second functions from chapter 7 46 | ; 47 | (define first 48 | (lambda (p) 49 | (car p))) 50 | 51 | (define second 52 | (lambda (p) 53 | (car (cdr p)))) 54 | 55 | ; And also third, later. 56 | ; 57 | (define third 58 | (lambda (l) 59 | (car (cdr (cdr l))))) 60 | 61 | ; The lookup-in-entry function looks in an entry to find the value by name 62 | ; 63 | (define lookup-in-entry 64 | (lambda (name entry entry-f) 65 | (lookup-in-entry-help 66 | name 67 | (first entry) 68 | (second entry) 69 | entry-f))) 70 | 71 | ; lookup-in-entry uses lookup-in-entry-help helper function 72 | ; 73 | (define lookup-in-entry-help 74 | (lambda (name names values entry-f) 75 | (cond 76 | ((null? names) (entry-f name)) 77 | ((eq? (car names) name) (car values)) 78 | (else 79 | (lookup-in-entry-help 80 | name 81 | (cdr names) 82 | (cdr values) 83 | entry-f))))) 84 | 85 | ; Let's try out lookup-in-entry 86 | ; 87 | (lookup-in-entry 88 | 'entree 89 | '((appetizer entree bevarage) (pate boeuf vin)) 90 | (lambda (n) '())) 91 | ; ==> 'boeuf 92 | 93 | (lookup-in-entry 94 | 'no-such-item 95 | '((appetizer entree bevarage) (pate boeuf vin)) 96 | (lambda (n) '())) 97 | ; ==> '() 98 | 99 | ; A table (also called an environment) is a list of entries. Here are some 100 | ; examples. 101 | ; 102 | '() 103 | '(((appetizer entree beverage) (pate boeuf vin)) 104 | ((beverage dessert) ((food is) (number one with us)))) 105 | 106 | ; The extend-table function takes an entry and a table and adds entry to the 107 | ; table 108 | ; 109 | (define extend-table cons) 110 | 111 | ; lookup-in-table finds an entry in a table 112 | ; 113 | (define lookup-in-table 114 | (lambda (name table table-f) 115 | (cond 116 | ((null? table) (table-f name)) 117 | (else 118 | (lookup-in-entry 119 | name 120 | (car table) 121 | (lambda (name) 122 | (lookup-in-table 123 | name 124 | (cdr table) 125 | table-f))))))) 126 | 127 | ; Let's try lookup-in-table 128 | ; 129 | (lookup-in-table 130 | 'beverage 131 | '(((entree dessert) (spaghetti spumoni)) 132 | ((appetizer entree beverage) (food tastes good))) 133 | (lambda (n) '())) 134 | ; ==> 'good 135 | 136 | ; Expressions to actions 137 | ; 138 | (define expression-to-action 139 | (lambda (e) 140 | (cond 141 | ((atom? e) (atom-to-action e)) 142 | (else 143 | (list-to-action e))))) 144 | 145 | ; Atom to action 146 | ; 147 | (define atom-to-action 148 | (lambda (e) 149 | (cond 150 | ((number? e) *const) 151 | ((eq? e #t) *const) 152 | ((eq? e #f) *const) 153 | ((eq? e 'cons) *const) 154 | ((eq? e 'car) *const) 155 | ((eq? e 'cdr) *const) 156 | ((eq? e 'null?) *const) 157 | ((eq? e 'eq?) *const) 158 | ((eq? e 'atom?) *const) 159 | ((eq? e 'zero?) *const) 160 | ((eq? e 'add1) *const) 161 | ((eq? e 'sub1) *const) 162 | ((eq? e 'number?) *const) 163 | (else *identifier)))) 164 | 165 | ; List to action 166 | ; 167 | (define list-to-action 168 | (lambda (e) 169 | (cond 170 | ((atom? (car e)) 171 | (cond 172 | ((eq? (car e) 'quote) *quote) 173 | ((eq? (car e) 'lambda) *lambda) 174 | ((eq? (car e) 'cond) *cond) 175 | (else *application))) 176 | (else *application)))) 177 | 178 | ; The value function takes an expression and evaulates it 179 | ; 180 | (define value 181 | (lambda (e) 182 | (meaning e '()))) 183 | 184 | ; The meaning function translates an expression to its meaning 185 | ; 186 | (define meaning 187 | (lambda (e table) 188 | ((expression-to-action e) e table))) 189 | 190 | ; Now the various actions. Let's start with *const 191 | ; 192 | (define *const 193 | (lambda (e table) 194 | (cond 195 | ((number? e) e) 196 | ((eq? e #t) #t) 197 | ((eq? e #f) #f) 198 | (else 199 | (build 'primitive e))))) 200 | 201 | ; *quote: (quote text) 202 | ; 203 | (define *quote 204 | (lambda (e table) 205 | (text-of e))) 206 | 207 | ; text-of 208 | ; 209 | (define text-of second) 210 | 211 | ; *identifier 212 | ; 213 | (define *identifier 214 | (lambda (e table) 215 | (lookup-in-table e table initial-table))) 216 | 217 | ; initial-table 218 | ; 219 | (define initial-table 220 | (lambda (name) 221 | (car '()))) ; let's hope we don't take this path 222 | 223 | ; *lambda 224 | ; 225 | (define *lambda 226 | (lambda (e table) 227 | (build 'non-primitive 228 | (cons table (cdr e))))) 229 | 230 | ; Let's add helper functions 231 | ; 232 | (define table-of first) 233 | (define formals-of second) 234 | (define body-of third) 235 | 236 | ; cond takes lines, and returns the value for the first true line 237 | ; 238 | (define evcon 239 | (lambda (lines table) 240 | (cond 241 | ((else? (question-of (car lines))) 242 | (meaning (answer-of (car lines)) table)) 243 | ((meaning (question-of (car lines)) table) 244 | (meaning (answer-of (car lines)) table)) 245 | (else 246 | (evcon (cdr lines) table))))) ; we don't ask null?, better one of cond lines be true! 247 | 248 | ; evcon needs else?, question-of and answer-of 249 | ; 250 | (define else? 251 | (lambda (x) 252 | (cond 253 | ((atom? x) (eq? x 'else)) 254 | (else #f)))) 255 | 256 | (define question-of first) 257 | (define answer-of second) 258 | 259 | ; Now we can write the real *cond 260 | ; 261 | (define *cond 262 | (lambda (e table) 263 | (evcon (cond-lines-of e) table))) 264 | 265 | (define cond-lines-of cdr) 266 | 267 | ; evlis finds meaning of arguments 268 | ; 269 | (define evlis 270 | (lambda (args table) 271 | (cond 272 | ((null? args) '()) 273 | (else 274 | (cons (meaning (car args) table) 275 | (evlis (cdr args) table)))))) 276 | 277 | ; Finally the *application 278 | ; 279 | (define *application 280 | (lambda (e table) 281 | (applyz 282 | (meaning (function-of e) table) 283 | (evlis (arguments-of e) table)))) 284 | 285 | (define function-of car) 286 | (define arguments-of cdr) 287 | 288 | ; Is the function a primitive? 289 | ; 290 | (define primitive? 291 | (lambda (l) 292 | (eq? (first l) 'primitive))) 293 | 294 | ; Is the function a non-primitive? 295 | ; 296 | (define non-primitive? 297 | (lambda (l) 298 | (eq? (first l) 'non-primitive))) 299 | 300 | ; Apply! 301 | ; 302 | (define applyz 303 | (lambda (fun vals) 304 | (cond 305 | ((primitive? fun) 306 | (apply-primitive (second fun) vals)) 307 | ((non-primitive? fun) 308 | (apply-closure (second fun) vals))))) 309 | 310 | ; apply-primitive 311 | ; 312 | (define apply-primitive 313 | (lambda (name vals) 314 | (cond 315 | ((eq? name 'cons) 316 | (cons (first vals) (second vals))) 317 | ((eq? name 'car) 318 | (car (first vals))) 319 | ((eq? name 'cdr) 320 | (cdr (first vals))) 321 | ((eq? name 'null?) 322 | (null? (first vals))) 323 | ((eq? name 'eq?) 324 | (eq? (first vals) (second vals))) 325 | ((eq? name 'atom?) 326 | (:atom? (first vals))) 327 | ((eq? name 'zero?) 328 | (zero? (first vals))) 329 | ((eq? name 'add1) 330 | (+ 1 (first vals))) 331 | ((eq? name 'sub1) 332 | (- 1 (first vals))) 333 | ((eq? name 'number?) 334 | (number? (first vals)))))) 335 | 336 | ; :atom? 337 | ; 338 | (define :atom? 339 | (lambda (x) 340 | (cond 341 | ((atom? x) #t) 342 | ((null? x) #f) 343 | ((eq? (car x) 'primitive) #t) 344 | ((eq? (car x) 'non-primitive) #t) 345 | (else #f)))) 346 | 347 | ; apply-closure 348 | ; 349 | (define apply-closure 350 | (lambda (closure vals) 351 | (meaning 352 | (body-of closure) 353 | (extend-table (new-entry 354 | (formals-of closure) 355 | vals) 356 | (table-of closure))))) 357 | 358 | ; 359 | ; Let's try out our brand new Scheme interpreter! 360 | ; 361 | 362 | (value '(add1 6)) ; 7 363 | (value '(quote (a b c))) ; '(a b c) 364 | (value '(car (quote (a b c)))) ; 'a 365 | (value '(cdr (quote (a b c)))) ; '(b c) 366 | (value 367 | '((lambda (x) 368 | (cons x (quote ()))) 369 | (quote (foo bar baz)))) ; '((foo bar baz)) 370 | (value 371 | '((lambda (x) 372 | (cond 373 | (x (quote true)) 374 | (else 375 | (quote false)))) 376 | #t)) ; 'true 377 | 378 | 379 | ; 380 | ; Go get yourself this wonderful book and have fun with these examples! 381 | ; 382 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 383 | ; 384 | ; Sincerely, 385 | ; Peteris Krumins 386 | ; http://www.catonmat.net 387 | ; 388 | 389 | -------------------------------------------------------------------------------- /07-friends-and-relations.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 7 of The Little Schemer: 3 | ; Friends and Relations 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; member function from Chapter 2 (02-do-it-again.ss) 12 | ; 13 | (define member? 14 | (lambda (a lat) 15 | (cond 16 | ((null? lat) #f) 17 | (else (or (eq? (car lat) a) 18 | (member? a (cdr lat))))))) 19 | 20 | ; atom? function from Chapter 1 (01-toys.ss) 21 | (define atom? 22 | (lambda (x) 23 | (and (not (pair? x)) (not (null? x))))) 24 | 25 | ; Example of a set 26 | ; 27 | '(apples peaches pears plums) 28 | 29 | ; Example of not a set 30 | ; 31 | '(apple peaches apple plum) ; because 'apple appears twice 32 | 33 | ; The set? function determines if a given lat is a set 34 | ; 35 | (define set? 36 | (lambda (lat) 37 | (cond 38 | ((null? lat) #t) 39 | ((member? (car lat) (cdr lat)) #f) 40 | (else 41 | (set? (cdr lat)))))) 42 | 43 | ; Examples of set? 44 | ; 45 | (set? '(apples peaches pears plums)) ; #t 46 | (set? '(apple peaches apple plum)) ; #f 47 | (set? '(apple 3 pear 4 9 apple 3 4)) ; #f 48 | 49 | ; The makeset funciton takes a lat and produces a set 50 | ; 51 | (define makeset 52 | (lambda (lat) 53 | (cond 54 | ((null? lat) '()) 55 | ((member? (car lat) (cdr lat)) (makeset (cdr lat))) 56 | (else 57 | (cons (car lat) (makeset (cdr lat))))))) 58 | 59 | ; Example of makeset 60 | ; 61 | (makeset '(apple peach pear peach plum apple lemon peach)) 62 | ; ==> '(pear plum apple lemon peach) 63 | 64 | ; makeset via multirember from Chapter 3 (03-cons-the-magnificent.ss) 65 | ; 66 | (define multirember 67 | (lambda (a lat) 68 | (cond 69 | ((null? lat) '()) 70 | ((eq? (car lat) a) 71 | (multirember a (cdr lat))) 72 | (else 73 | (cons (car lat) (multirember a (cdr lat))))))) 74 | 75 | (define makeset 76 | (lambda (lat) 77 | (cond 78 | ((null? lat) '()) 79 | (else 80 | (cons (car lat) 81 | (makeset (multirember (car lat) (cdr lat)))))))) 82 | 83 | ; Test makeset 84 | ; 85 | (makeset '(apple peach pear peach plum apple lemon peach)) 86 | ; ==> '(apple peach pear plum lemon) 87 | 88 | (makeset '(apple 3 pear 4 9 apple 3 4)) 89 | ; ==> '(apple 3 pear 4 9) 90 | 91 | ; The subset? function determines if set1 is a subset of set2 92 | ; 93 | (define subset? 94 | (lambda (set1 set2) 95 | (cond 96 | ((null? set1) #t) 97 | ((member? (car set1) set2) 98 | (subset? (cdr set1) set2)) 99 | (else #f)))) 100 | 101 | ; Examples of subset? 102 | ; 103 | (subset? '(5 chicken wings) 104 | '(5 hamburgers 2 pieces fried chicken and light duckling wings)) 105 | ; ==> #t 106 | 107 | (subset? '(4 pounds of horseradish) 108 | '(four pounds of chicken and 5 ounces of horseradish)) 109 | ; ==> #f 110 | 111 | ; A shorter version of subset? 112 | ; 113 | (define subset? 114 | (lambda (set1 set2) 115 | (cond 116 | ((null? set1) #t) 117 | (else (and (member? (car set1) set2) 118 | (subset? (cdr set1) set2)))))) 119 | 120 | ; Tests of the new subset? 121 | ; 122 | (subset? '(5 chicken wings) 123 | '(5 hamburgers 2 pieces fried chicken and light duckling wings)) 124 | ; ==> #t 125 | 126 | (subset? '(4 pounds of horseradish) 127 | '(four pounds of chicken and 5 ounces of horseradish)) 128 | ; ==> #f 129 | 130 | ; The eqset? function determines if two sets are equal 131 | ; 132 | (define eqset? 133 | (lambda (set1 set2) 134 | (and (subset? set1 set2) 135 | (subset? set2 set1)))) 136 | 137 | ; Examples of eqset? 138 | ; 139 | (eqset? '(a b c) '(c b a)) ; #t 140 | (eqset? '() '()) ; #t 141 | (eqset? '(a b c) '(a b)) ; #f 142 | 143 | ; The intersect? function finds if two sets intersect 144 | ; 145 | (define intersect? 146 | (lambda (set1 set2) 147 | (cond 148 | ((null? set1) #f) 149 | ((member? (car set1) set2) #t) 150 | (else 151 | (intersect? (cdr set1) set2))))) 152 | 153 | ; Examples of intersect? 154 | ; 155 | (intersect? 156 | '(stewed tomatoes and macaroni) 157 | '(macaroni and cheese)) 158 | ; ==> #t 159 | 160 | (intersect? 161 | '(a b c) 162 | '(d e f)) 163 | ; ==> #f 164 | 165 | ; A shorter version of intersect? 166 | ; 167 | (define intersect? 168 | (lambda (set1 set2) 169 | (cond 170 | ((null? set1) #f) 171 | (else (or (member? (car set1) set2) 172 | (intersect? (cdr set1) set2)))))) 173 | 174 | ; Tests of intersect? 175 | ; 176 | (intersect? 177 | '(stewed tomatoes and macaroni) 178 | '(macaroni and cheese)) 179 | ; ==> #t 180 | 181 | (intersect? 182 | '(a b c) 183 | '(d e f)) 184 | ; ==> #f 185 | 186 | ; The intersect function finds the intersect between two sets 187 | ; 188 | (define intersect 189 | (lambda (set1 set2) 190 | (cond 191 | ((null? set1) '()) 192 | ((member? (car set1) set2) 193 | (cons (car set1) (intersect (cdr set1) set2))) 194 | (else 195 | (intersect (cdr set1) set2))))) 196 | 197 | ; Example of intersect 198 | ; 199 | (intersect 200 | '(stewed tomatoes and macaroni) 201 | '(macaroni and cheese)) 202 | ; ==> '(and macaroni) 203 | 204 | ; The union function finds union of two sets 205 | ; 206 | (define union 207 | (lambda (set1 set2) 208 | (cond 209 | ((null? set1) set2) 210 | ((member? (car set1) set2) 211 | (union (cdr set1) set2)) 212 | (else (cons (car set1) (union (cdr set1) set2)))))) 213 | 214 | ; Example of union 215 | ; 216 | (union 217 | '(stewed tomatoes and macaroni casserole) 218 | '(macaroni and cheese)) 219 | ; ==> '(stewed tomatoes casserole macaroni and cheese) 220 | 221 | ; The xxx function is the set difference function 222 | ; 223 | (define xxx 224 | (lambda (set1 set2) 225 | (cond 226 | ((null? set1) '()) 227 | ((member? (car set1) set2) 228 | (xxx (cdr set1) set2)) 229 | (else 230 | (cons (car set1) (xxx (cdr set1) set2)))))) 231 | 232 | ; Example of set difference 233 | ; 234 | (xxx '(a b c) '(a b d e f)) ; '(c) 235 | 236 | ; The intersectall function finds intersect between multitude of sets 237 | ; 238 | (define intersectall 239 | (lambda (l-set) 240 | (cond 241 | ((null? (cdr l-set)) (car l-set)) 242 | (else 243 | (intersect (car l-set) (intersectall (cdr l-set))))))) 244 | 245 | ; Examples of intersectall 246 | ; 247 | (intersectall '((a b c) (c a d e) (e f g h a b))) ; '(a) 248 | (intersectall 249 | '((6 pears and) 250 | (3 peaches and 6 peppers) 251 | (8 pears and 6 plums) 252 | (and 6 prunes with some apples))) ; '(6 and) 253 | 254 | ; The a-pair? function determines if it's a pair 255 | ; 256 | (define a-pair? 257 | (lambda (x) 258 | (cond 259 | ((atom? x) #f) 260 | ((null? x) #f) 261 | ((null? (cdr x)) #f) 262 | ((null? (cdr (cdr x))) #t) 263 | (else #f)))) 264 | 265 | ; Examples of pairs 266 | ; 267 | (a-pair? '(pear pear)) ; #t 268 | (a-pair? '(3 7)) ; #t 269 | (a-pair? '((2) (pair))) ; #t 270 | (a-pair? '(full (house))) ; #t 271 | 272 | ; Examples of not-pairs 273 | (a-pair? '()) ; #f 274 | (a-pair? '(a b c)) ; #f 275 | 276 | ; Helper functions for working with pairs 277 | ; 278 | (define first 279 | (lambda (p) 280 | (car p))) 281 | 282 | (define second 283 | (lambda (p) 284 | (car (cdr p)))) 285 | 286 | (define build 287 | (lambda (s1 s2) 288 | (cons s1 (cons s2 '())))) 289 | 290 | ; Just an example of how you'd write third 291 | ; 292 | (define third 293 | (lambda (l) 294 | (car (cdr (cdr l))))) 295 | 296 | ; Example of a not-relations 297 | ; 298 | '(apples peaches pumpkins pie) 299 | '((apples peaches) (pumpkin pie) (apples peaches)) 300 | 301 | ; Examples of relations 302 | ; 303 | '((apples peaches) (pumpkin pie)) 304 | '((4 3) (4 2) (7 6) (6 2) (3 4)) 305 | 306 | ; The fun? function determines if rel is a function 307 | ; 308 | (define fun? 309 | (lambda (rel) 310 | (set? (firsts rel)))) 311 | 312 | ; It uses firsts function from Chapter 3 (03-cons-the-magnificent.ss) 313 | (define firsts 314 | (lambda (l) 315 | (cond 316 | ((null? l) '()) 317 | (else 318 | (cons (car (car l)) (firsts (cdr l))))))) 319 | 320 | ; Examples of fun? 321 | ; 322 | (fun? '((4 3) (4 2) (7 6) (6 2) (3 4))) ; #f 323 | (fun? '((8 3) (4 2) (7 6) (6 2) (3 4))) ; #t 324 | (fun? '((d 4) (b 0) (b 9) (e 5) (g 4))) ; #f 325 | 326 | ; The revrel function reverses a relation 327 | ; 328 | (define revrel 329 | (lambda (rel) 330 | (cond 331 | ((null? rel) '()) 332 | (else (cons (build (second (car rel)) 333 | (first (car rel))) 334 | (revrel (cdr rel))))))) 335 | 336 | ; Example of revrel 337 | ; 338 | (revrel '((8 a) (pumpkin pie) (got sick))) 339 | ; ==> '((a 8) (pie pumpkin) (sick got)) 340 | 341 | ; Let's simplify revrel by using inventing revpair that reverses a pair 342 | ; 343 | (define revpair 344 | (lambda (p) 345 | (build (second p) (first p)))) 346 | 347 | ; Simplified revrel 348 | ; 349 | (define revrel 350 | (lambda (rel) 351 | (cond 352 | ((null? rel) '()) 353 | (else (cons (revpair (car rel)) (revrel (cdr rel))))))) 354 | 355 | ; Test of simplified revrel 356 | ; 357 | (revrel '((8 a) (pumpkin pie) (got sick))) 358 | ; ==> '((a 8) (pie pumpkin) (sick got)) 359 | 360 | ; The fullfun? function determines if the given function is full 361 | ; 362 | (define fullfun? 363 | (lambda (fun) 364 | (set? (seconds fun)))) 365 | 366 | ; It uses seconds helper function 367 | ; 368 | (define seconds 369 | (lambda (l) 370 | (cond 371 | ((null? l) '()) 372 | (else 373 | (cons (second (car l)) (seconds (cdr l))))))) 374 | 375 | ; Examples of fullfun? 376 | ; 377 | (fullfun? '((8 3) (4 2) (7 6) (6 2) (3 4))) ; #f 378 | (fullfun? '((8 3) (4 8) (7 6) (6 2) (3 4))) ; #t 379 | (fullfun? '((grape raisin) 380 | (plum prune) 381 | (stewed prune))) ; #f 382 | 383 | ; one-to-one? is the same fullfun? 384 | ; 385 | (define one-to-one? 386 | (lambda (fun) 387 | (fun? (revrel fun)))) 388 | 389 | (one-to-one? '((8 3) (4 2) (7 6) (6 2) (3 4))) ; #f 390 | (one-to-one? '((8 3) (4 8) (7 6) (6 2) (3 4))) ; #t 391 | (one-to-one? '((grape raisin) 392 | (plum prune) 393 | (stewed prune))) ; #f 394 | 395 | (one-to-one? '((chocolate chip) (doughy cookie))) 396 | ; ==> #t and you deserve one now! 397 | 398 | ; 399 | ; Go get yourself this wonderful book and have fun with these examples! 400 | ; 401 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 402 | ; 403 | ; Sincerely, 404 | ; Peteris Krumins 405 | ; http://www.catonmat.net 406 | ; 407 | 408 | -------------------------------------------------------------------------------- /04-numbers-games.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 4 of The Little Schemer: 3 | ; Numbers Games 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; Assume add1 is a primitive 12 | ; 13 | (define add1 14 | (lambda (n) (+ n 1))) 15 | 16 | ; Example of add1 17 | ; 18 | (add1 67) ; 68 19 | 20 | ; Assume sub1 is a primitive 21 | ; 22 | (define sub1 23 | (lambda (n) (- n 1))) 24 | 25 | ; Example of sub1 26 | ; 27 | (sub1 5) ; 5 28 | 29 | ; Example of zero? 30 | ; 31 | (zero? 0) ; true 32 | (zero? 1492) ; false 33 | 34 | ; The o+ function adds two numbers 35 | ; 36 | (define o+ 37 | (lambda (n m) 38 | (cond 39 | ((zero? m) n) 40 | (else (add1 (o+ n (sub1 m))))))) 41 | 42 | ; Example of o+ 43 | ; 44 | (o+ 46 12) ; 58 45 | 46 | ; The o- function subtracts one number from the other 47 | ; 48 | (define o- 49 | (lambda (n m) 50 | (cond 51 | ((zero? m) n) 52 | (else (sub1 (o- n (sub1 m))))))) 53 | 54 | ; Example of o- 55 | ; 56 | (o- 14 3) ; 11 57 | (o- 17 9) ; 8 58 | 59 | ; Examples of tups (tup is short for tuple) 60 | ; 61 | '(2 111 3 79 47 6) 62 | '(8 55 5 555) 63 | '() 64 | 65 | ; Examples of not-tups 66 | ; 67 | '(1 2 8 apple 4 3) ; not-a-tup because apple is not a number 68 | '(3 (7 4) 13 9) ; not-a-tup because (7 4) is a list of numbers, not a number 69 | 70 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 71 | ; ; 72 | ; The first commandment (first revision) ; 73 | ; ; 74 | ; When recurring on a list of atoms, lat, ask two questions about it: ; 75 | ; (null? lat) and else. ; 76 | ; When recurring on a number, n, ask two questions about it: (zero? n) and ; 77 | ; else. ; 78 | ; ; 79 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 80 | 81 | ; The addtup function adds all numbers in a tup 82 | ; 83 | (define addtup 84 | (lambda (tup) 85 | (cond 86 | ((null? tup) 0) 87 | (else (o+ (car tup) (addtup (cdr tup))))))) 88 | 89 | ; Examples of addtup 90 | ; 91 | (addtup '(3 5 2 8)) ; 18 92 | (addtup '(15 6 7 12 3)) ; 43 93 | 94 | ; The o* function multiplies two numbers 95 | ; 96 | (define o* 97 | (lambda (n m) 98 | (cond 99 | ((zero? m) 0) 100 | (else (o+ n (o* n (sub1 m))))))) 101 | 102 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 103 | ; ; 104 | ; The fourth commandment (first revision) ; 105 | ; ; 106 | ; Always change at least one argument while recurring. It must be changed to ; 107 | ; be closer to termination. The changing argument must be tested in the ; 108 | ; termination condition: ; 109 | ; when using cdr, test the termination with null? and ; 110 | ; when using sub1, test termination with zero?. ; 111 | ; ; 112 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 113 | 114 | ; Examples of o* 115 | ; 116 | (o* 5 3) ; 15 117 | (o* 13 4) ; 52 118 | 119 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 120 | ; ; 121 | ; The fifth commandment ; 122 | ; ; 123 | ; When building a value with o+, always use 0 for the value of the ; 124 | ; terminating line, for adding 0 does not change the value of an addition. ; 125 | ; ; 126 | ; When building a value with o*, always use 1 for the value of the ; 127 | ; terminating line, for multiplying by 1 does not change the value of a ; 128 | ; multiplication. ; 129 | ; ; 130 | ; When building a value with cons, always consider () for the value of the ; 131 | ; terminating line. ; 132 | ; ; 133 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 134 | 135 | ; The tup+ function adds two tups 136 | ; 137 | (define tup+ 138 | (lambda (tup1 tup2) 139 | (cond 140 | ((null? tup1) tup2) 141 | ((null? tup2) tup1) 142 | (else 143 | (cons (o+ (car tup1) (car tup2)) 144 | (tup+ (cdr tup1) (cdr tup2))))))) 145 | 146 | ; Examples of tup+ 147 | ; 148 | (tup+ '(3 6 9 11 4) '(8 5 2 0 7)) ; '(11 11 11 11 11) 149 | (tup+ '(3 7) '(4 6 8 1)) ; '(7 13 8 1) 150 | 151 | ; The o> function compares n with m and returns true if n>m 152 | ; 153 | (define o> 154 | (lambda (n m) 155 | (cond 156 | ((zero? n) #f) 157 | ((zero? m) #t) 158 | (else 159 | (o> (sub1 n) (sub1 m)))))) 160 | 161 | ; Examples of o> 162 | ; 163 | (o> 12 133) ; #f (false) 164 | (o> 120 11) ; #t (true) 165 | (o> 6 6) ; #f 166 | 167 | ; The o< function compares n with m and returns true if n n m) #f) 189 | ((o< n m) #f) 190 | (else #t)))) 191 | 192 | ; Examples of o= 193 | ; 194 | (o= 5 5) ; #t 195 | (o= 1 2) ; #f 196 | 197 | ; The o^ function computes n^m 198 | ; 199 | (define o^ 200 | (lambda (n m) 201 | (cond 202 | ((zero? m) 1) 203 | (else (o* n (o^ n (sub1 m))))))) 204 | 205 | ; Examples of o^ 206 | ; 207 | (o^ 1 1) ; 1 208 | (o^ 2 3) ; 8 209 | (o^ 5 3) ; 125 210 | 211 | ; The o/ function computes the integer part of n/m 212 | ; 213 | (define o/ 214 | (lambda (n m) 215 | (cond 216 | ((o< n m) 0) 217 | (else (add1 (o/ (o- n m) m)))))) 218 | 219 | ; Example of o/ 220 | ; 221 | (o/ 15 4) ; 3 222 | 223 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 224 | ; ; 225 | ; Wouldn't a '(ham and cheese on rye) be good right now? ; 226 | ; ; 227 | ; Don't forget the 'mustard! ; 228 | ; ; 229 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 230 | 231 | ; The olength function finds the length of a lat 232 | ; 233 | (define olength 234 | (lambda (lat) 235 | (cond 236 | ((null? lat) 0) 237 | (else (add1 (olength (cdr lat))))))) 238 | 239 | ; Examples of length 240 | ; 241 | (olength '(hotdogs with mustard sauerkraut and pickles)) ; 6 242 | (olength '(ham and cheese on rye)) ; 5 243 | 244 | ; The pick function returns the n-th element in a lat 245 | ; 246 | (define pick 247 | (lambda (n lat) 248 | (cond 249 | ((zero? (sub1 n)) (car lat)) 250 | (else 251 | (pick (sub1 n) (cdr lat)))))) 252 | 253 | ; Example of pick 254 | ; 255 | (pick 4 '(lasagna spaghetti ravioli macaroni meatball)) ; 'macaroni 256 | 257 | ; The rempick function removes the n-th element and returns the new lat 258 | ; 259 | (define rempick 260 | (lambda (n lat) 261 | (cond 262 | ((zero? (sub1 n)) (cdr lat)) 263 | (else 264 | (cons (car lat) (rempick (sub1 n) (cdr lat))))))) 265 | 266 | ; Example of rempick 267 | ; 268 | (rempick 3 '(hotdogs with hot mustard)) ; '(hotdogs with mustard) 269 | 270 | ; The no-nums function returns a new lat with all numbers removed 271 | ; 272 | (define no-nums 273 | (lambda (lat) 274 | (cond 275 | ((null? lat) '()) 276 | ((number? (car lat)) (no-nums (cdr lat))) 277 | (else 278 | (cons (car lat) (no-nums (cdr lat))))))) 279 | 280 | ; Example of no-nums 281 | ; 282 | (no-nums '(5 pears 6 prunes 9 dates)) ; '(pears prunes dates) 283 | 284 | ; The all-nums does the opposite of no-nums - returns a new lat with 285 | ; only numbers 286 | ; 287 | (define all-nums 288 | (lambda (lat) 289 | (cond 290 | ((null? lat) '()) 291 | ((number? (car lat)) (cons (car lat) (all-nums (cdr lat)))) 292 | (else 293 | (all-nums (cdr lat)))))) 294 | 295 | ; Example of all-nums 296 | ; 297 | (all-nums '(5 pears 6 prunes 9 dates)) ; '(5 6 9) 298 | 299 | 300 | ; The eqan? function determines whether two arguments are te same 301 | ; It uses eq? for atoms and = for numbers 302 | ; 303 | (define eqan? 304 | (lambda (a1 a2) 305 | (cond 306 | ((and (number? a1) (number? a2)) (= a1 a2)) 307 | ((or (number? a1) (number? a2)) #f) 308 | (else 309 | (eq? a1 a2))))) 310 | 311 | ; Examples of eqan? 312 | ; 313 | (eqan? 3 3) ; #t 314 | (eqan? 3 4) ; #f 315 | (eqan? 'a 'a) ; #t 316 | (eqan? 'a 'b) ; #f 317 | 318 | ; The occur function counts the number of times an atom appears 319 | ; in a list 320 | ; 321 | (define occur 322 | (lambda (a lat) 323 | (cond 324 | ((null? lat) 0) 325 | ((eq? (car lat) a) 326 | (add1 (occur a (cdr lat)))) 327 | (else 328 | (occur a (cdr lat)))))) 329 | 330 | ; Example of occur 331 | ; 332 | (occur 'x '(a b x x c d x)) ; 3 333 | (occur 'x '()) ; 0 334 | 335 | ; The one? function is true when n=1 336 | ; 337 | (define one? 338 | (lambda (n) (= n 1))) 339 | 340 | ; Example of one? 341 | ; 342 | (one? 5) ; #f 343 | (one? 1) ; #t 344 | 345 | ; We can rewrite rempick using one? 346 | ; 347 | (define rempick-one 348 | (lambda (n lat) 349 | (cond 350 | ((one? n) (cdr lat)) 351 | (else 352 | (cons (car lat) (rempick-one (sub1 n) (cdr lat))))))) 353 | 354 | ; Example of rempick-one 355 | ; 356 | (rempick-one 4 '(hotdogs with hot mustard)) ; '(hotdogs with mustard) 357 | 358 | ; 359 | ; Go get yourself this wonderful book and have fun with these examples! 360 | ; 361 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 362 | ; 363 | ; Sincerely, 364 | ; Peteris Krumins 365 | ; http://www.catonmat.net 366 | ; 367 | 368 | -------------------------------------------------------------------------------- /05-full-of-stars.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 5 of The Little Schemer: 3 | ; *Oh My Gawd*: It's Full of Stars 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; The atom? primitive 12 | ; 13 | (define atom? 14 | (lambda (x) 15 | (and (not (pair? x)) (not (null? x))))) 16 | 17 | ; The add1 primitive 18 | ; 19 | (define add1 20 | (lambda (n) (+ n 1))) 21 | 22 | ; The rember* function removes all matching atoms from an s-expression 23 | ; 24 | (define rember* 25 | (lambda (a l) 26 | (cond 27 | ((null? l) '()) 28 | ((atom? (car l)) 29 | (cond 30 | ((eq? (car l) a) 31 | (rember* a (cdr l))) 32 | (else 33 | (cons (car l) (rember* a (cdr l)))))) 34 | (else 35 | (cons (rember* a (car l)) (rember* a (cdr l))))))) 36 | 37 | ; Examples of rember* 38 | ; 39 | (rember* 40 | 'cup 41 | '((coffee) cup ((tea) cup) (and (hick)) cup)) 42 | ;==> '((coffee) ((tea)) (and (hick))) 43 | 44 | (rember* 45 | 'sauce 46 | '(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce))) 47 | ;==> '(((tomato)) ((bean)) (and ((flying)))) 48 | 49 | ; The insertR* function insers new to the right of all olds in l 50 | ; 51 | (define insertR* 52 | (lambda (new old l) 53 | (cond 54 | ((null? l) '()) 55 | ((atom? (car l)) 56 | (cond 57 | ((eq? (car l) old) 58 | (cons old (cons new (insertR* new old (cdr l))))) 59 | (else 60 | (cons (car l) (insertR* new old (cdr l)))))) 61 | (else 62 | (cons (insertR* new old (car l)) (insertR* new old (cdr l))))))) 63 | 64 | ; Example of insertR* 65 | ; 66 | (insertR* 67 | 'roast 68 | 'chuck 69 | '((how much (wood)) could ((a (wood) chuck)) (((chuck))) 70 | (if (a) ((wood chuck))) could chuck wood)) 71 | ; ==> ((how much (wood)) could ((a (wood) chuck roast)) (((chuck roast))) 72 | ; (if (a) ((wood chuck roast))) could chuck roast wood) 73 | 74 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 75 | ; ; 76 | ; The first commandment (final version) ; 77 | ; ; 78 | ; When recurring on a list of atoms, lat, ask two questions about it: ; 79 | ; (null? lat) and else. ; 80 | ; When recurring on a number, n, ask two questions about it: (zero? n) and ; 81 | ; else. ; 82 | ; When recurring on a list of S-expressions, l, ask three questions about ; 83 | ; it: (null? l), (atom? (car l)), and else. ; 84 | ; ; 85 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 86 | 87 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 88 | ; ; 89 | ; The fourth commandment (final version) ; 90 | ; ; 91 | ; Always change at least one argument while recurring. When recurring on a ; 92 | ; list of atoms, lat, use (cdr l). When recurring on a number, n, use ; 93 | ; (sub1 n). And when recurring on a list of S-expressions, l, use (car l) ; 94 | ; and (cdr l) if neither (null? l) nor (atom? (car l)) are true. ; 95 | ; ; 96 | ; It must be changed to be closer to termination. The changing argument must ; 97 | ; be tested in the termination condition: ; 98 | ; * when using cdr, test the termination with null? and ; 99 | ; * when using sub1, test termination with zero?. ; 100 | ; ; 101 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 102 | 103 | ; The occur* function counts the number of occurances of an atom in l 104 | ; 105 | (define occur* 106 | (lambda (a l) 107 | (cond 108 | ((null? l) 0) 109 | ((atom? (car l)) 110 | (cond 111 | ((eq? (car l) a) 112 | (add1 (occur* a (cdr l)))) 113 | (else 114 | (occur* a (cdr l))))) 115 | (else 116 | (+ (occur* a (car l)) 117 | (occur* a (cdr l))))))) 118 | 119 | ; Example of occur* 120 | ; 121 | (occur* 122 | 'banana 123 | '((banana) 124 | (split ((((banana ice))) 125 | (cream (banana)) 126 | sherbet)) 127 | (banana) 128 | (bread) 129 | (banana brandy))) 130 | ;==> 5 131 | 132 | ; The subst* function substitutes all olds for news in l 133 | ; 134 | (define subst* 135 | (lambda (new old l) 136 | (cond 137 | ((null? l) '()) 138 | ((atom? (car l)) 139 | (cond 140 | ((eq? (car l) old) 141 | (cons new (subst* new old (cdr l)))) 142 | (else 143 | (cons (car l) (subst* new old (cdr l)))))) 144 | (else 145 | (cons (subst* new old (car l)) (subst* new old (cdr l))))))) 146 | 147 | ; Example of subst* 148 | ; 149 | (subst* 150 | 'orange 151 | 'banana 152 | '((banana) 153 | (split ((((banana ice))) 154 | (cream (banana)) 155 | sherbet)) 156 | (banana) 157 | (bread) 158 | (banana brandy))) 159 | ;==> '((orange) 160 | ; (split ((((orange ice))) 161 | ; (cream (orange)) 162 | ; sherbet)) 163 | ; (orange) 164 | ; (bread) 165 | ; (orange brandy)) 166 | 167 | ; The insertL* function insers new to the left of all olds in l 168 | ; 169 | (define insertL* 170 | (lambda (new old l) 171 | (cond 172 | ((null? l) '()) 173 | ((atom? (car l)) 174 | (cond 175 | ((eq? (car l) old) 176 | (cons new (cons old (insertL* new old (cdr l))))) 177 | (else 178 | (cons (car l) (insertL* new old (cdr l)))))) 179 | (else 180 | (cons (insertL* new old (car l)) (insertL* new old (cdr l))))))) 181 | 182 | ; Example of insertL* 183 | ; 184 | (insertL* 185 | 'pecker 186 | 'chuck 187 | '((how much (wood)) could ((a (wood) chuck)) (((chuck))) 188 | (if (a) ((wood chuck))) could chuck wood)) 189 | ; ==> ((how much (wood)) could ((a (wood) chuck pecker)) (((chuck pecker))) 190 | ; (if (a) ((wood chuck pecker))) could chuck pecker wood) 191 | 192 | ; The member* function determines if element is in a list l of s-exps 193 | ; 194 | (define member* 195 | (lambda (a l) 196 | (cond 197 | ((null? l) #f) 198 | ((atom? (car l)) 199 | (or (eq? (car l) a) 200 | (member* a (cdr l)))) 201 | (else 202 | (or (member* a (car l)) 203 | (member* a (cdr l))))))) 204 | 205 | ; Example of member* 206 | ; 207 | (member 208 | 'chips 209 | '((potato) (chips ((with) fish) (chips)))) ; #t 210 | 211 | ; The leftmost function finds the leftmost atom in a non-empty list 212 | ; of S-expressions that doesn't contain the empty list 213 | ; 214 | (define leftmost 215 | (lambda (l) 216 | (cond 217 | ((atom? (car l)) (car l)) 218 | (else (leftmost (car l)))))) 219 | 220 | ; Examples of leftmost 221 | ; 222 | (leftmost '((potato) (chips ((with) fish) (chips)))) ; 'potato 223 | (leftmost '(((hot) (tuna (and))) cheese)) ; 'hot 224 | 225 | ; Examples of not-applicable leftmost 226 | ; 227 | ; (leftmost '(((() four)) 17 (seventeen))) ; leftmost s-expression is empty 228 | ; (leftmost '()) ; empty list 229 | 230 | ; Or expressed via cond 231 | ; 232 | ; (or a b) = (cond (a #t) (else b)) 233 | 234 | ; And expressed via cond 235 | ; 236 | ; (and a b) = (cond (a b) (else #f)) 237 | 238 | ; The eqlist? function determines if two lists are equal 239 | ; 240 | (define eqlist? 241 | (lambda (l1 l2) 242 | (cond 243 | ; case 1: l1 is empty, l2 is empty, atom, list 244 | ((and (null? l1) (null? l2)) #t) 245 | ((and (null? l1) (atom? (car l2))) #f) 246 | ((null? l1) #f) 247 | ; case 2: l1 is atom, l2 is empty, atom, list 248 | ((and (atom? (car l1)) (null? l2)) #f) 249 | ((and (atom? (car l1)) (atom? (car l2))) 250 | (and (eq? (car l1) (car l2)) 251 | (eqlist? (cdr l1) (cdr l2)))) 252 | ((atom? (car l1)) #f) 253 | ; case 3: l1 is a list, l2 is empty, atom, list 254 | ((null? l2) #f) 255 | ((atom? (car l2)) #f) 256 | (else 257 | (and (eqlist? (car l1) (car l2)) 258 | (eqlist? (cdr l1) (cdr l2))))))) 259 | 260 | 261 | ; Example of eqlist? 262 | ; 263 | (eqlist? 264 | '(strawberry ice cream) 265 | '(strawberry ice cream)) ; #t 266 | 267 | (eqlist? 268 | '(strawberry ice cream) 269 | '(strawberry cream ice)) ; #f 270 | 271 | (eqlist? 272 | '(banan ((split))) 273 | '((banana) split)) ; #f 274 | 275 | (eqlist? 276 | '(beef ((sausage)) (and (soda))) 277 | '(beef ((salami)) (and (soda)))) ; #f 278 | 279 | (eqlist? 280 | '(beef ((sausage)) (and (soda))) 281 | '(beef ((sausage)) (and (soda)))) ; #t 282 | 283 | ; eqlist? rewritten 284 | ; 285 | (define eqlist2? 286 | (lambda (l1 l2) 287 | (cond 288 | ; case 1: l1 is empty, l2 is empty, atom, list 289 | ((and (null? l1) (null? l2)) #t) 290 | ((or (null? l1) (null? l2)) #f) 291 | ; case 2: l1 is atom, l2 is empty, atom, list 292 | ((and (atom? (car l1)) (atom? (car l2))) 293 | (and (eq? (car l1) (car l2)) 294 | (eqlist2? (cdr l1) (cdr l2)))) 295 | ((or (atom? (car l1)) (atom? (car l2))) 296 | #f) 297 | ; case 3: l1 is a list, l2 is empty, atom, list 298 | (else 299 | (and (eqlist2? (car l1) (car l2)) 300 | (eqlist2? (cdr l1) (cdr l2))))))) 301 | 302 | ; Tests of eqlist2? 303 | ; 304 | (eqlist2? 305 | '(strawberry ice cream) 306 | '(strawberry ice cream)) ; #t 307 | 308 | (eqlist2? 309 | '(strawberry ice cream) 310 | '(strawberry cream ice)) ; #f 311 | 312 | (eqlist2? 313 | '(banan ((split))) 314 | '((banana) split)) ; #f 315 | 316 | (eqlist2? 317 | '(beef ((sausage)) (and (soda))) 318 | '(beef ((salami)) (and (soda)))) ; #f 319 | 320 | (eqlist2? 321 | '(beef ((sausage)) (and (soda))) 322 | '(beef ((sausage)) (and (soda)))) ; #t 323 | 324 | ; The equal? function determines if two s-expressions are equal 325 | ; 326 | (define equal?? 327 | (lambda (s1 s2) 328 | (cond 329 | ((and (atom? s1) (atom? s2)) 330 | (eq? s1 s2)) 331 | ((atom? s1) #f) 332 | ((atom? s2) #f) 333 | (else (eqlist? s1 s2))))) 334 | 335 | ; Examples of equal?? 336 | ; 337 | (equal?? 'a 'a) ; #t 338 | (equal?? 'a 'b) ; #f 339 | (equal?? '(a) 'a) ; #f 340 | (equal?? '(a) '(a)) ; #t 341 | (equal?? '(a) '(b)) ; #f 342 | (equal?? '(a) '()) ; #f 343 | (equal?? '() '(a)) ; #f 344 | (equal?? '(a b c) '(a b c)) ; #t 345 | (equal?? '(a (b c)) '(a (b c))) ; #t 346 | (equal?? '(a ()) '(a ())) ; #t 347 | 348 | ; equal? simplified 349 | ; 350 | (define equal2?? 351 | (lambda (s1 s2) 352 | (cond 353 | ((and (atom? s1) (atom? s2)) 354 | (eq? s1 s2)) 355 | ((or (atom? s1) (atom? s2)) #f) 356 | (else (eqlist? s1 s2))))) 357 | 358 | ; Tests of equal2?? 359 | ; 360 | (equal2?? 'a 'a) ; #t 361 | (equal2?? 'a 'b) ; #f 362 | (equal2?? '(a) 'a) ; #f 363 | (equal2?? '(a) '(a)) ; #t 364 | (equal2?? '(a) '(b)) ; #f 365 | (equal2?? '(a) '()) ; #f 366 | (equal2?? '() '(a)) ; #f 367 | (equal2?? '(a b c) '(a b c)) ; #t 368 | (equal2?? '(a (b c)) '(a (b c))) ; #t 369 | (equal2?? '(a ()) '(a ())) ; #t 370 | 371 | ; eqlist? rewritten using equal2?? 372 | ; 373 | (define eqlist3? 374 | (lambda (l1 l2) 375 | (cond 376 | ((and (null? l1) (null? l2)) #t) 377 | ((or (null? l1) (null? l2)) #f) 378 | (else 379 | (and (equal2?? (car l1) (car l2)) 380 | (equal2?? (cdr l1) (cdr l2))))))) 381 | 382 | ; Tests of eqlist3? 383 | ; 384 | (eqlist3? 385 | '(strawberry ice cream) 386 | '(strawberry ice cream)) ; #t 387 | 388 | (eqlist3? 389 | '(strawberry ice cream) 390 | '(strawberry cream ice)) ; #f 391 | 392 | (eqlist3? 393 | '(banan ((split))) 394 | '((banana) split)) ; #f 395 | 396 | (eqlist3? 397 | '(beef ((sausage)) (and (soda))) 398 | '(beef ((salami)) (and (soda)))) ; #f 399 | 400 | (eqlist3? 401 | '(beef ((sausage)) (and (soda))) 402 | '(beef ((sausage)) (and (soda)))) ; #t 403 | 404 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 405 | ; ; 406 | ; The sixth commandment ; 407 | ; ; 408 | ; Simplify only after the function is correct. ; 409 | ; ; 410 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 411 | 412 | ; rember simplified, it now also works on s-expressions, not just atoms 413 | ; 414 | (define rember 415 | (lambda (s l) 416 | (cond 417 | ((null? l) '()) 418 | ((equal2?? (car l) s) (cdr l)) 419 | (else (cons (car l) (rember s (cdr l))))))) 420 | 421 | ; Example of rember 422 | ; 423 | (rember 424 | '(foo (bar (baz))) 425 | '(apples (foo (bar (baz))) oranges)) 426 | ;==> '(apples oranges) 427 | 428 | ; 429 | ; Go get yourself this wonderful book and have fun with these examples! 430 | ; 431 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 432 | ; 433 | ; Sincerely, 434 | ; Peteris Krumins 435 | ; http://www.catonmat.net 436 | ; 437 | 438 | -------------------------------------------------------------------------------- /08-lambda-the-ultimate.ss: -------------------------------------------------------------------------------- 1 | ; 2 | ; Chapter 8 of The Little Schemer: 3 | ; Lambda the Ultimate 4 | ; 5 | ; Code examples assemled by Peteris Krumins (peter@catonmat.net). 6 | ; His blog is at http://www.catonmat.net -- good coders code, great reuse. 7 | ; 8 | ; Get yourself this wonderful book at Amazon: http://bit.ly/4GjWdP 9 | ; 10 | 11 | ; The atom? primitive 12 | ; 13 | (define atom? 14 | (lambda (x) 15 | (and (not (pair? x)) (not (null? x))))) 16 | 17 | ; The rember-f function takes the test function, element, and a list 18 | ; and removes the element that test true 19 | ; 20 | (define rember-f 21 | (lambda (test? a l) 22 | (cond 23 | ((null? l) '()) 24 | ((test? (car l) a) (cdr l)) 25 | (else 26 | (cons (car l) (rember-f test? a (cdr l))))))) 27 | 28 | ; Examples of rember-f 29 | ; 30 | (rember-f eq? 2 '(1 2 3 4 5)) 31 | ; ==> '(1 3 4 5) 32 | 33 | ; The eq?-c function takes an atom and returns a function that 34 | ; takes an atom and tests if they are the same 35 | ; 36 | (define eq?-c 37 | (lambda (a) 38 | (lambda (x) 39 | (eq? a x)))) 40 | 41 | ; Example of eq?-c 42 | ; 43 | ((eq?-c 'tuna) 'tuna) ; #t 44 | ((eq?-c 'tuna) 'salad) ; #f 45 | 46 | (define eq?-salad (eq?-c 'salad)) 47 | 48 | ; Examples of eq?-salad 49 | ; 50 | (eq?-salad 'salad) ; #t 51 | (eq?-salad 'tuna) ; #f 52 | 53 | ; Another version of rember-f that takes test as an argument 54 | ; and returns a function that takes an element and a list 55 | ; and removes the element from the list 56 | ; 57 | (define rember-f 58 | (lambda (test?) 59 | (lambda (a l) 60 | (cond 61 | ((null? l) '()) 62 | ((test? (car l) a) (cdr l)) 63 | (else 64 | (cons (car l) ((rember-f test?) a (cdr l)))))))) 65 | 66 | ; Test of rember-f 67 | ; 68 | ((rember-f eq?) 2 '(1 2 3 4 5)) 69 | ; ==> '(1 3 4 5) 70 | 71 | ; Curry (rember-f eq?) 72 | ; 73 | (define rember-eq? (rember-f eq?)) 74 | 75 | ; Test curried function 76 | ; 77 | (rember-eq? 2 '(1 2 3 4 5)) 78 | ; ==> '(1 3 4 5) 79 | (rember-eq? 'tuna '(tuna salad is good)) 80 | ; ==> '(salad is good) 81 | (rember-eq? 'tuna '(shrimp salad and tuna salad)) 82 | ; ==> '(shrimp salad and salad) 83 | (rember-eq? 'eq? '(equal? eq? eqan? eqlist? eqpair?)) 84 | ; ==> '(equal? eqan? eqlist? eqpair?) 85 | 86 | ; The insertL function from Chapter 3 (03-cons-the-magnificent.ss) 87 | ; This time curried 88 | ; 89 | (define insertL-f 90 | (lambda (test?) 91 | (lambda (new old l) 92 | (cond 93 | ((null? l) '()) 94 | ((test? (car l) old) 95 | (cons new (cons old (cdr l)))) 96 | (else 97 | (cons (car l) ((insertL-f test?) new old (cdr l)))))))) 98 | 99 | ; Test insertL-f 100 | ; 101 | ((insertL-f eq?) 102 | 'd 103 | 'e 104 | '(a b c e f g d h)) ; '(a b c d e f g d h) 105 | 106 | ; The insertR function, curried 107 | ; 108 | (define insertR-f 109 | (lambda (test?) 110 | (lambda (new old l) 111 | (cond 112 | ((null? l) '()) 113 | ((test? (car l) old) 114 | (cons old (cons new (cdr l)))) 115 | (else 116 | (cons (car l) ((insertR-f test?) new old (cdr l)))))))) 117 | 118 | ; Test insertR-f 119 | ((insertR-f eq?) 120 | 'e 121 | 'd 122 | '(a b c d f g d h)) ; '(a b c d e f g d h) 123 | 124 | ; The seqL function is what insertL does that insertR doesn't 125 | ; 126 | (define seqL 127 | (lambda (new old l) 128 | (cons new (cons old l)))) 129 | 130 | ; The seqR function is what insertR does that insertL doesn't 131 | ; 132 | (define seqR 133 | (lambda (new old l) 134 | (cons old (cons new l)))) 135 | 136 | ; insert-g acts as insertL or insertR depending on the helper 137 | ; function passed to it 138 | ; 139 | (define insert-g 140 | (lambda (seq) 141 | (lambda (new old l) 142 | (cond 143 | ((null? l) '()) 144 | ((eq? (car l) old) 145 | (seq new old (cdr l))) 146 | (else 147 | (cons (car l) ((insert-g seq) new old (cdr l)))))))) 148 | 149 | ; insertL is now just (insert-g seqL) 150 | ; 151 | (define insertL (insert-g seqL)) 152 | 153 | ; insertR is now just (insert-g seqR) 154 | ; 155 | (define insertR (insert-g seqR)) 156 | 157 | ; Test insertL 158 | ; 159 | (insertL 160 | 'd 161 | 'e 162 | '(a b c e f g d h)) ; '(a b c d e f g d h) 163 | 164 | ; Test insertR 165 | (insertR 166 | 'e 167 | 'd 168 | '(a b c d f g d h)) ; '(a b c d e f g d h) 169 | 170 | ; insertL can also be defined by passing it a lambda 171 | ; 172 | (define insertL 173 | (insert-g 174 | (lambda (new old l) 175 | (cons new (cons old l))))) 176 | 177 | ; Test insertL 178 | ; 179 | (insertL 180 | 'd 181 | 'e 182 | '(a b c e f g d h)) ; '(a b c d e f g d h) 183 | 184 | ; The subst function from Chapter 3 (03-cons-the-magnificent.ss) 185 | ; 186 | (define subst-f 187 | (lambda (new old l) 188 | (cond 189 | ((null? l) '()) 190 | ((eq? (car l) old) 191 | (cons new (cdr l))) 192 | (else 193 | (cons (car l) (subst new old (cdr l))))))) 194 | 195 | ; The seqS function is what subst does that neither insertL nor insertR do 196 | ; 197 | (define seqS 198 | (lambda (new old l) 199 | (cons new l))) 200 | 201 | ; subst is now just (insret-g seqS) 202 | ; 203 | (define subst (insert-g seqS)) 204 | 205 | ; Test subst 206 | ; 207 | (subst 208 | 'topping 209 | 'fudge 210 | '(ice cream with fudge for dessert)) ; '(ice cream with topping for dessert) 211 | 212 | ; Guess what yyy is 213 | ; 214 | (define yyy 215 | (lambda (a l) 216 | ((insert-g seqrem) #f a l))) 217 | 218 | ; yyy uses seqrem 219 | (define seqrem 220 | (lambda (new old l) 221 | l)) 222 | 223 | ; It's rember! Let's test it. 224 | ; 225 | (yyy 226 | 'sausage 227 | '(pizza with sausage and bacon)) ; '(pizza with and bacon) 228 | 229 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 230 | ; ; 231 | ; The ninth commandment ; 232 | ; ; 233 | ; Abstract common patterns with a new function. ; 234 | ; ; 235 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 236 | 237 | ; Remember the value function from Chapter 6 (06-shadows.ss)? 238 | ; 239 | (define value 240 | (lambda (nexp) 241 | (cond 242 | ((atom? nexp) nexp) 243 | ((eq? (car (cdr nexp)) 'o+) 244 | (+ (value (car nexp)) 245 | (value (car (cdr (cdr nexp)))))) 246 | ((eq? (car (cdr nexp)) 'o*) 247 | (* (value (car nexp)) 248 | (value (car (cdr (cdr nexp)))))) 249 | ((eq? (car (cdr nexp)) 'o^) 250 | (expt (value (car nexp)) 251 | (value (car (cdr (cdr nexp)))))) 252 | (else #f)))) 253 | 254 | ; Let's abstract it 255 | ; 256 | (define atom-to-function 257 | (lambda (atom) 258 | (cond 259 | ((eq? atom 'o+) +) 260 | ((eq? atom 'o*) *) 261 | ((eq? atom 'o^) expt) 262 | (else #f)))) 263 | 264 | ; atom-to-function uses operator 265 | ; 266 | (define operator 267 | (lambda (aexp) 268 | (car aexp))) 269 | 270 | ; Example of atom-to-function 271 | ; 272 | (atom-to-function (operator '(o+ 5 3))) ; + (function plus) 273 | 274 | ; The value function rewritten to use abstraction 275 | ; 276 | (define value 277 | (lambda (nexp) 278 | (cond 279 | ((atom? nexp) nexp) 280 | (else 281 | ((atom-to-function (operator nexp)) 282 | (value (1st-sub-exp nexp)) 283 | (value (2nd-sub-exp nexp))))))) 284 | 285 | ; value uses 1st-sub-exp 286 | ; 287 | (define 1st-sub-exp 288 | (lambda (aexp) 289 | (car (cdr aexp)))) 290 | 291 | ; value uses 2nd-sub-exp 292 | (define 2nd-sub-exp 293 | (lambda (aexp) 294 | (car (cdr (cdr aexp))))) 295 | 296 | ; Test value 297 | ; 298 | (value 13) ; 13 299 | (value '(o+ 1 3)) ; 4 300 | (value '(o+ 1 (o^ 3 4))) ; 82 301 | 302 | ; The multirember function from Chapter 3 (03-cons-the-magnificent.ss) 303 | ; 304 | (define multirember 305 | (lambda (a lat) 306 | (cond 307 | ((null? lat) '()) 308 | ((eq? (car lat) a) 309 | (multirember a (cdr lat))) 310 | (else 311 | (cons (car lat) (multirember a (cdr lat))))))) 312 | 313 | ; The multirember-f is multirember with a possibility to curry f 314 | ; 315 | (define multirember-f 316 | (lambda (test?) 317 | (lambda (a lat) 318 | (cond 319 | ((null? lat) '()) 320 | ((test? (car lat) a) 321 | ((multirember-f test?) a (cdr lat))) 322 | (else 323 | (cons (car lat) ((multirember-f test?) a (cdr lat)))))))) 324 | 325 | ; Test multirember-f 326 | ; 327 | ((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna)) 328 | ; ==> '(shrimp salad salad and) 329 | 330 | ; Curry multirember-f with eq? 331 | ; 332 | (define multirember-eq? (multirember-f eq?)) 333 | 334 | ; The multiremberT changes the way test works 335 | ; 336 | (define multiremberT 337 | (lambda (test? lat) 338 | (cond 339 | ((null? lat) '()) 340 | ((test? (car lat)) 341 | (multiremberT test? (cdr lat))) 342 | (else 343 | (cons (car lat) 344 | (multiremberT test? (cdr lat))))))) 345 | 346 | ; eq?-tuna tests if element is equal to 'tuna 347 | ; 348 | (define eq?-tuna 349 | (eq?-c 'tuna)) 350 | 351 | ; Example of multiremberT 352 | ; 353 | (multiremberT 354 | eq?-tuna 355 | '(shrimp salad tuna salad and tuna)) 356 | ; ==> '(shrimp salad salad and) 357 | 358 | ; The multiremember&co uses a collector 359 | ; 360 | (define multiremember&co 361 | (lambda (a lat col) 362 | (cond 363 | ((null? lat) 364 | (col '() '())) 365 | ((eq? (car lat) a) 366 | (multiremember&co a (cdr lat) 367 | (lambda (newlat seen) 368 | (col newlat (cons (car lat) seen))))) 369 | (else 370 | (multiremember&co a (cdr lat) 371 | (lambda (newlat seen) 372 | (col (cons (car lat) newlat) seen))))))) 373 | 374 | ; The friendly function 375 | ; 376 | (define a-friend 377 | (lambda (x y) 378 | (null? y))) 379 | 380 | ; Examples of multiremember&co with friendly function 381 | ; 382 | (multiremember&co 383 | 'tuna 384 | '(strawberries tuna and swordfish) 385 | a-friend) 386 | ; ==> #f 387 | (multiremember&co 388 | 'tuna 389 | '() 390 | a-friend) 391 | ; ==> #t 392 | (multiremember&co 393 | 'tuna 394 | '(tuna) 395 | a-friend) 396 | ; ==> #f 397 | 398 | ; The new friend function 399 | ; 400 | (define new-friend 401 | (lambda (newlat seen) 402 | (a-friend newlat (cons 'tuna seen)))) 403 | 404 | ; Examples of multiremember&co with the new friend function 405 | ; 406 | (multiremember&co 407 | 'tuna 408 | '(strawberries tuna and swordfish) 409 | new-friend) 410 | ; ==> #f 411 | (multiremember&co 412 | 'tuna 413 | '() 414 | new-friend) 415 | ; ==> #f 416 | (multiremember&co 417 | 'tuna 418 | '(tuna) 419 | new-friend) 420 | ; ==> #f 421 | 422 | ; The last friend function 423 | ; 424 | (define last-friend 425 | (lambda (x y) 426 | (length x))) 427 | 428 | ; Examples of multiremember&co with the last friend function 429 | ; 430 | (multiremember&co 431 | 'tuna 432 | '(strawberries tuna and swordfish) 433 | last-friend) 434 | ; ==> 3 435 | (multiremember&co 436 | 'tuna 437 | '() 438 | last-friend) 439 | ; ==> 0 440 | (multiremember&co 441 | 'tuna 442 | '(tuna) 443 | last-friend) 444 | ; ==> 0 445 | 446 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 447 | ; ; 448 | ; The tenth commandment ; 449 | ; ; 450 | ; Build functions to collect more than one value at a time. ; 451 | ; ; 452 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 453 | 454 | ; The multiinsertLR inserts to the left and to the right of elements 455 | ; 456 | (define multiinsertLR 457 | (lambda (new oldL oldR lat) 458 | (cond 459 | ((null? lat) '()) 460 | ((eq? (car lat) oldL) 461 | (cons new 462 | (cons oldL 463 | (multiinsertLR new oldL oldR (cdr lat))))) 464 | ((eq? (car lat) oldR) 465 | (cons oldR 466 | (cons new 467 | (multiinsertLR new oldL oldR (cdr lat))))) 468 | (else 469 | (cons 470 | (car lat) 471 | (multiinsertLR new oldL oldR (cdr lat))))))) 472 | 473 | ; Example of multiinsertLR 474 | ; 475 | (multiinsertLR 476 | 'x 477 | 'a 478 | 'b 479 | '(a o a o b o b b a b o)) 480 | ; ==> '(x a o x a o b x o b x b x x a b x o) 481 | 482 | ; The multiinsertLR&co is to multiinsertLR what multirember is to 483 | ; multiremember&co 484 | ; 485 | (define multiinsertLR&co 486 | (lambda (new oldL oldR lat col) 487 | (cond 488 | ((null? lat) 489 | (col '() 0 0)) 490 | ((eq? (car lat) oldL) 491 | (multiinsertLR&co new oldL oldR (cdr lat) 492 | (lambda (newlat L R) 493 | (col (cons new (cons oldL newlat)) 494 | (+ 1 L) R)))) 495 | ((eq? (car lat) oldR) 496 | (multiinsertLR&co new oldL oldR (cdr lat) 497 | (lambda (newlat L R) 498 | (col (cons oldR (cons new newlat)) 499 | L (+ 1 R))))) 500 | (else 501 | (multiinsertLR&co new oldL oldR (cdr lat) 502 | (lambda (newlat L R) 503 | (col (cons (car lat) newlat) 504 | L R))))))) 505 | 506 | ; Some collectors 507 | ; 508 | (define col1 509 | (lambda (lat L R) 510 | lat)) 511 | (define col2 512 | (lambda (lat L R) 513 | L)) 514 | (define col3 515 | (lambda (lat L R) 516 | R)) 517 | 518 | ; Examples of multiinsertLR&co 519 | ; 520 | (multiinsertLR&co 521 | 'salty 522 | 'fish 523 | 'chips 524 | '(chips and fish or fish and chips) 525 | col1) 526 | ; ==> '(chips salty and salty fish or salty fish and chips salty) 527 | (multiinsertLR&co 528 | 'salty 529 | 'fish 530 | 'chips 531 | '(chips and fish or fish and chips) 532 | col2) 533 | ; ==> 2 534 | (multiinsertLR&co 535 | 'salty 536 | 'fish 537 | 'chips 538 | '(chips and fish or fish and chips) 539 | col3) 540 | ; ==> 2 541 | 542 | ; The evens-only* function leaves all even numbers in an sexpression 543 | ; (removes odd numbers) 544 | ; 545 | (define evens-only* 546 | (lambda (l) 547 | (cond 548 | ((null? l) '()) 549 | ((atom? (car l)) 550 | (cond 551 | ((even? (car l)) 552 | (cons (car l) 553 | (evens-only* (cdr l)))) 554 | (else 555 | (evens-only* (cdr l))))) 556 | (else 557 | (cons (evens-only* (car l)) 558 | (evens-only* (cdr l))))))) 559 | 560 | ; Example of evens-only* 561 | ; 562 | (evens-only* 563 | '((9 1 2 8) 3 10 ((9 9) 7 6) 2)) ; '((2 8) 10 (() 6) 2) 564 | 565 | ; Evens only function with a collector, collects evens, their product, 566 | ; and sum of odd numbers 567 | ; 568 | (define evens-only*&co 569 | (lambda (l col) 570 | (cond 571 | ((null? l) 572 | (col '() 1 0)) 573 | ((atom? (car l)) 574 | (cond 575 | ((even? (car l)) 576 | (evens-only*&co (cdr l) 577 | (lambda (newl p s) 578 | (col (cons (car l) newl) (* (car l) p) s)))) 579 | (else 580 | (evens-only*&co (cdr l) 581 | (lambda (newl p s) 582 | (col newl p (+ (car l) s))))))) 583 | (else 584 | (evens-only*&co (car l) 585 | (lambda (al ap as) 586 | (evens-only*&co (cdr l) 587 | (lambda (dl dp ds) 588 | (col (cons al dl) 589 | (* ap dp) 590 | (+ as ds)))))))))) 591 | 592 | ; evens-friend returns collected evens 593 | ; 594 | (define evens-friend 595 | (lambda (e p s) 596 | e)) 597 | 598 | ; Example of evens-friend used 599 | ; 600 | (evens-only*&co 601 | '((9 1 2 8) 3 10 ((9 9) 7 6) 2) 602 | evens-friend) 603 | ; ==> '((2 8) 10 (() 6) 2) 604 | 605 | ; evens-product-friend returns the product of evens 606 | ; 607 | (define evens-product-friend 608 | (lambda (e p s) 609 | p)) 610 | 611 | ; Example of evens-product-friend used 612 | ; 613 | (evens-only*&co 614 | '((9 1 2 8) 3 10 ((9 9) 7 6) 2) 615 | evens-product-friend) 616 | ; ==> 1920 617 | 618 | ; evens-sum-friend returns the sum of odds 619 | ; 620 | (define evens-sum-friend 621 | (lambda (e p s) 622 | s)) 623 | 624 | ; Example of evens-sum-friend used 625 | ; 626 | (evens-only*&co 627 | '((9 1 2 8) 3 10 ((9 9) 7 6) 2) 628 | evens-sum-friend) 629 | ; ==> 38 630 | 631 | ; the-last-friend returns sum, product and the list of evens consed together 632 | ; 633 | (define the-last-friend 634 | (lambda (e p s) 635 | (cons s (cons p e)))) 636 | 637 | ; Example of the-last-friend 638 | ; 639 | (evens-only*&co 640 | '((9 1 2 8) 3 10 ((9 9) 7 6) 2) 641 | the-last-friend) 642 | ; ==> '(38 1920 (2 8) 10 (() 6) 2) 643 | 644 | ; 645 | ; Go get yourself this wonderful book and have fun with these examples! 646 | ; 647 | ; Shortened URL to the book at Amazon.com: http://bit.ly/4GjWdP 648 | ; 649 | ; Sincerely, 650 | ; Peteris Krumins 651 | ; http://www.catonmat.net 652 | ; 653 | 654 | -------------------------------------------------------------------------------- /readme.txt: -------------------------------------------------------------------------------- 1 | This repository contains all the code examples from the book "The Little 2 | Schemer." The code in this book is presented in a subset version of the Scheme 3 | programming language. The book is a dialogue between you and the authors about 4 | interesting examples of Scheme programs and it teaches you to think 5 | recursively. 6 | 7 | If you're interested, get the book from Amazon: http://bit.ly/4GjWdP 8 | 9 | The code examples were copied (and completed where necessary) from 10 | "The Little Schemer" by Peteris Krumins (peter@catonmat.net). 11 | 12 | His blog is at http://www.catonmat.net -- good coders code, great reuse. 13 | 14 | ------------------------------------------------------------------------------ 15 | 16 | Table of contents: 17 | [01] Chapter 1: Toys 18 | 01-toys.ss 19 | [02] Chapter 2: Do It, Do It Again, and Again, and Again... 20 | 02-do-it-again.ss 21 | [03] Chapter 3: Cons the Magnificent 22 | 03-cons-the-magnificent.ss 23 | [04] Chapter 4: Numbers Games 24 | 04-numbers-games.ss 25 | [05] Chapter 5: *Oh My Gawd*: It's Full of Stars 26 | 05-full-of-stars.ss 27 | [06] Chapter 6: Shadows 28 | 06-shadows.ss 29 | [07] Chapter 7: Shadows 30 | 07-friends-and-relations.ss 31 | [08] Chapter 8: Lambda the Ultimate 32 | 08-lambda-the-ultimate.ss 33 | [09] Chapter 9: ... and Again, and Again, and Again ... 34 | 09-and-again.ss 35 | [10] Chapter 10: What Is the Value of All of This? 36 | 10-value-of-all-of-this.ss 37 | 38 | 39 | [01]-Chapter-1-Toys----------------------------------------------------------- 40 | 41 | See 01-toys.ss file for code examples. 42 | 43 | Chapter 1 introduces language primitives, operations and tests on them. 44 | 45 | The primitives include: atoms, lists and s-expressions. 46 | Operations include: car, cdr, cons. 47 | Tests include: null?, atom?, eq?. 48 | 49 | It also defines five rules on using car, cdr, cons, null? and eq?. 50 | 51 | The law of car: The primitive car is defined only for non-empty lists. 52 | The law of cdr: The primitive cdr is defined only for non-empty lists. 53 | The cdr of any non-empty list is always another list. 54 | The law of cons: The primitive cons takes two arguments. 55 | The second argument to cons must be a list. 56 | The result is a list. 57 | The law of null?: The primitive null? is defined only for lists. 58 | The law of eq?: The primitive eq? takes two arguments. 59 | Each must be a non-numeric atom. 60 | 61 | 62 | .----------------------------------------------------------------------------. 63 | | | 64 | | This space reserved for | 65 | | JELLY STAINS! | 66 | | | 67 | '----------------------------------------------------------------------------' 68 | 69 | 70 | [02]-Chapter-2-Do-It-Do-It-Again-and-Again-and-Again-------------------------- 71 | 72 | See 02-do-it-again.ss file for code examples. 73 | 74 | Chapter 2 introduces two recursive functions and steps through them again, and 75 | again, and again until you understand recursion. 76 | 77 | The first function introduced is lat? that tests if the given list consists 78 | only of atoms (lat stands for list of atoms). 79 | 80 | The second function introduced is member? that tests if an element is in a 81 | lat. 82 | 83 | It also defines a preliminary version of the first commandment that always 84 | should be followed when programming recursively. 85 | 86 | .----------------------------------------------------------------------------. 87 | | The first commandment: (preliminary version) | 88 | | | 89 | | Always ask null? as the first question in expressing any function. | 90 | '----------------------------------------------------------------------------' 91 | 92 | 93 | [03]-Chapter-3-Cons-the-Magnificent------------------------------------------- 94 | 95 | See 03-cons-the-magnificent.ss file for code examples. 96 | 97 | Chapter 3 explains how to build lists with cons. It's done via showing how to 98 | write a function that removes an element from the list. Then the second 99 | commandment is presented. 100 | 101 | .----------------------------------------------------------------------------. 102 | | The second commandment: | 103 | | | 104 | | Use cons to build lists. | 105 | '----------------------------------------------------------------------------' 106 | 107 | Next, it's precisely explained how to do recursion and when to stop recursing, 108 | this leads to the third commandment and a preliminary version of the fourth 109 | commandment. The examples include a function that inserts an element in a list 110 | to the right and to the left of the given element, and a function that removes 111 | the first occurrence of an element from a list. 112 | 113 | .----------------------------------------------------------------------------. 114 | | The third commandment: | 115 | | | 116 | | When building lists, describe the first typical element, and then cons it | 117 | | onto the natural recursion. | 118 | '----------------------------------------------------------------------------' 119 | 120 | Next the multi-versions of the same functions are written that insert element 121 | to the right and to the left of all occurrences of the given element in a list, 122 | and a function that removes all occurrences of an element from a list. 123 | 124 | .----------------------------------------------------------------------------. 125 | | The fourth commandment: (preliminary version) | 126 | | | 127 | | Always change at least one argument while recurring. It must be changed to | 128 | | be closer to termination. The changing argument must be tested in the | 129 | | termination condition: when using cdr, test the termination with null?. | 130 | '----------------------------------------------------------------------------' 131 | 132 | [04]-Chapter-4-Numbers-Games-------------------------------------------------- 133 | 134 | See 04-numbers-games.ss file for code examples. 135 | 136 | Chapter 4 builds the arithmetic system from the primitives add1 and sub1. 137 | 138 | Using add1 the usual + addition operation on two numbers is developed, next 139 | using sub1 the usual - subtraction operation is developed, then multiplication 140 | and exponentiation are written. 141 | 142 | Along the way the first and fourth commandments are revisited: 143 | 144 | .----------------------------------------------------------------------------. 145 | | The first commandment (first revision) | 146 | | | 147 | | When recurring on a list of atoms, lat, ask two questions about it: | 148 | | (null? lat) and else. | 149 | | When recurring on a number, n, ask two questions about it: (zero? n) and | 150 | | else. | 151 | '----------------------------------------------------------------------------' 152 | 153 | .----------------------------------------------------------------------------. 154 | | The fourth commandment (first revision) | 155 | | | 156 | | Always change at least one argument while recurring. It must be changed to | 157 | | be closer to termination. The changing argument must be tested in the | 158 | | termination condition: | 159 | | when using cdr, test the termination with null? and | 160 | | when using sub1, test termination with zero?. | 161 | '----------------------------------------------------------------------------' 162 | 163 | And the fifth commandment is postulated: 164 | 165 | .----------------------------------------------------------------------------. 166 | | The fifth commandment | 167 | | | 168 | | When building a value with o+, always use 0 for the value of the | 169 | | terminating line, for adding 0 does not change the value of an addition. | 170 | | | 171 | | When building a value with o*, always use 1 for the value of the | 172 | | terminating line, for multiplying by 1 does not change the value of a | 173 | | multiplication. | 174 | | | 175 | | When building a value with cons, always consider () for the value of the | 176 | | terminating line. | 177 | '----------------------------------------------------------------------------' 178 | 179 | Next the < greater than and > less than operations are derived, then the = 180 | equals operation and quotient operation. 181 | 182 | Then various utility functions are written, such as length that determines the 183 | length of a list, pick that picks the n-th element from the list, rempick that 184 | removes the n-th element from the list, no-nums that extracts all non-numeric 185 | elements from the list, all-nums that does the opposite and extracts all 186 | numeric elements from the list. 187 | 188 | [05]-Chapter-5-Oh-My-Gawd-It's-Full-of-Stars---------------------------------- 189 | 190 | See 05-full-of-stars.ss file for code examples. 191 | 192 | Chapter 5 introduces you to S-expressions and functions that manipulate them. 193 | 194 | The first commandment is finalized: 195 | 196 | .----------------------------------------------------------------------------. 197 | | The first commandment (final version) | 198 | | | 199 | | When recurring on a list of atoms, lat, ask two questions about it: | 200 | | (null? lat) and else. | 201 | | When recurring on a number, n, ask two questions about it: (zero? n) and | 202 | | else. | 203 | | When recurring on a list of S-expressions, l, ask three questions about | 204 | | it: (null? l), (atom? (car l)), and else. | 205 | '----------------------------------------------------------------------------' 206 | 207 | And the fourth commandment is stated: 208 | 209 | .----------------------------------------------------------------------------. 210 | | The fourth commandment (final version) | 211 | | | 212 | | Always change at least one argument while recurring. When recurring on a | 213 | | list of atoms, lat, use (cdr l). When recurring on a number, n, use | 214 | | (sub1 n). And when recurring on a list of S-expressions, l, use (car l) | 215 | | and (cdr l) if neither (null? l) nor (atom? (car l)) are true. | 216 | | | 217 | | It must be changed to be closer to termination. The changing argument must | 218 | | be tested in the termination condition: | 219 | | * when using cdr, test the termination with null? and | 220 | | * when using sub1, test termination with zero?. | 221 | '----------------------------------------------------------------------------' 222 | 223 | Functions rember, insertR, insertL, occur, subst, member are then rewritten to 224 | manipulate S-expressions and not just lists of atoms. 225 | 226 | Then functions for comparing two S-expressions are written, and rewritten 227 | several times to teach you Scheme for great good. 228 | 229 | Finally the sixth commandment is presented: 230 | 231 | .----------------------------------------------------------------------------. 232 | | The sixth commandment | 233 | | | 234 | | Simplify only after the function is correct. | 235 | '----------------------------------------------------------------------------' 236 | 237 | [06]-Chapter-6-Shadows-------------------------------------------------------- 238 | 239 | See 06-shadows.ss file for code examples. 240 | 241 | Chapter 6 develops an evaluator for simple arithmetic expressions involving 242 | only +, * and exp. 243 | 244 | The seventh commandment is formulated as evaluator is developed: 245 | 246 | .----------------------------------------------------------------------------. 247 | | The seventh commandment | 248 | | | 249 | | Recur on the subparts that are of the same nature: | 250 | | * On the sublists of a list. | 251 | | * On the subexpressions of an arithmetic expression. | 252 | '----------------------------------------------------------------------------' 253 | 254 | Next different representations for arithmetic expressions are introduced. An 255 | expression (1 + 2) can be written as (+ 1 2) and (1 2 +) or even (plus 1 2). 256 | 257 | The concept of abstraction from representations is introduced. The eighth 258 | commandment follows: 259 | 260 | .----------------------------------------------------------------------------. 261 | | The eighth commandment | 262 | | | 263 | | Use help functions to abstract from representations. | 264 | '----------------------------------------------------------------------------' 265 | 266 | Finally chapter shows how numbers 0, 1, 2, ... can be represented purely as 267 | lists. The number 0 becomes (), number 1 becomes (()), 2 becomes (() ()), 268 | 3 becomes (() () ()), ... . Then functions for adding, subtracting and 269 | checking if the new number is zero are written. But beware of shadows, the 270 | lat? function doesn't work on a list of these numbers. 271 | 272 | 273 | [07]-Chapter-7-Friends-and-Relations------------------------------------------ 274 | 275 | See 07-friends-and-relations.ss file for code examples. 276 | 277 | Chapter 7 is all about sets. It defines functions to test if the given list is 278 | a set, to construct a set from a list, to test if set1 is a subset of set2, to 279 | determine if two sets are equal, to find intersect of two sets, to fund 280 | intersect of a bunch of sets, to find union of two sets. 281 | 282 | Then it introduces pairs and writes several helper functions: first that 283 | returns the first element of a pair, second that returns the second element of 284 | a pair, and build that builds a pair. (Remember commandment eight.) 285 | 286 | Then it plays with mathematical functions. It introduces relations, creates 287 | functions to reverse relations, and test if the given list of relations is a 288 | function and is it a full function. 289 | 290 | 291 | [08]-Chapter-8-Lambda-the-Ultimate-------------------------------------------- 292 | 293 | See 08-lambda-the-ultimate.ss file for code examples. 294 | 295 | Chapter 8 introduces the concept that functions can be passed and returned 296 | from functions. It also introduces currying. 297 | 298 | Next it reviews several functions from Chapter 3 and shows how they differ 299 | only by two lines. Those lines can be factored out as separate functions that 300 | simplifies the whole thing. 301 | 302 | The ninth commandment follows. 303 | 304 | .----------------------------------------------------------------------------. 305 | | The ninth commandment | 306 | | | 307 | | Abstract common patterns with a new function. | 308 | '----------------------------------------------------------------------------' 309 | 310 | Finally continuations are introduced via a bunch of examples, for example, 311 | multirember&co function collects the elements to be removed in one list, and 312 | the elements that were not removed in the other. After it's done, the 313 | collector is called, which is your own function so you may do anything you 314 | wish with those two lists. 315 | 316 | The final, tenth commandment, is stated. 317 | 318 | .----------------------------------------------------------------------------. 319 | | The tenth commandment | 320 | | | 321 | | Build functions to collect more than one value at a time. | 322 | '----------------------------------------------------------------------------' 323 | 324 | And remember, an apple a day keeps the doctor away. 325 | 326 | 327 | [09]-Chapter-9-and-Again-and-Again-and-Again---------------------------------- 328 | 329 | See 09-and-again.ss file for code examples. 330 | 331 | ... 332 | 333 | Used this chapter to write an article on derivation of Y-Combinator: 334 | http://www.catonmat.net/blog/derivation-of-ycombinator/ 335 | 336 | ... 337 | 338 | 339 | [10]-Chapter-10-What-Is-the-Value-of-All-of-This------------------------------ 340 | 341 | See 10-value-of-all-of-this.ss file for code examples. 342 | 343 | Chapter 10 implements Scheme in Scheme. That's it. 344 | 345 | It was a great adventure and now it's time for banquet! 346 | 347 | 348 | ------------------------------------------------------------------------------ 349 | 350 | That's it. I hope you find these examples useful when reading "The Little 351 | Schemer" yourself! Go get it at http://bit.ly/4GjWdP, if you haven't already! 352 | 353 | 354 | Sincerely, 355 | Peteris Krumins 356 | http://www.catonmat.net 357 | 358 | --------------------------------------------------------------------------------