Commit | Line | Data |
---|---|---|
0544b52f NB |
1 | ;; These are the answers to the questions in ../docs/exercise.md. |
2 | ||
9c20ca3f | 3 | ;; In order to avoid unexpected circular dependencies among solutions, |
dcaf3f21 | 4 | ;; this answer file attempts to be self-contained. |
9c20ca3f NB |
5 | (def! reduce (fn* (f init xs) |
6 | (if (empty? xs) init (reduce f (f init (first xs)) (rest xs))))) | |
7 | (def! foldr (fn* [f init xs] | |
8 | (if (empty? xs) init (f (first xs) (foldr f init (rest xs)))))) | |
9 | ||
10 | ;; Reimplementations. | |
1ca3ee3d | 11 | |
0544b52f NB |
12 | (def! nil? (fn* [x] (= x nil ))) |
13 | (def! true? (fn* [x] (= x true ))) | |
14 | (def! false? (fn* [x] (= x false))) | |
9678065e | 15 | (def! empty? (fn* [x] (= x [] ))) |
0544b52f | 16 | |
9678065e NB |
17 | (def! sequential? |
18 | (fn* [x] | |
9c20ca3f | 19 | (if (list? x) true (vector? x)))) |
0544b52f | 20 | |
9678065e NB |
21 | (def! > (fn* [a b] (< b a) )) |
22 | (def! <= (fn* [a b] (not (< b a)))) | |
23 | (def! >= (fn* [a b] (not (< a b)))) | |
0544b52f | 24 | |
0544b52f | 25 | (def! list (fn* [& xs] xs)) |
fbfe6784 | 26 | (def! vec (fn* [xs] (apply vector xs))) |
0544b52f | 27 | (def! prn (fn* [& xs] (println (apply pr-str xs)))) |
dcaf3f21 | 28 | (def! hash-map (fn* [& xs] (apply assoc {} xs))) |
0544b52f NB |
29 | (def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs)))) |
30 | ||
1ca3ee3d | 31 | (def! count |
9c20ca3f NB |
32 | (fn* [xs] |
33 | (if (nil? xs) | |
34 | 0 | |
35 | (reduce (fn* [acc _] (+ 1 acc)) 0 xs)))) | |
36 | (def! nth | |
37 | (fn* [xs index] | |
38 | (if (if (<= 0 index) (not (empty? xs))) ; logical and | |
39 | (if (= 0 index) | |
40 | (first xs) | |
41 | (nth (rest xs) (- index 1))) | |
42 | (throw "nth: index out of range")))) | |
0544b52f NB |
43 | (def! map |
44 | (fn* [f xs] | |
9c20ca3f | 45 | (foldr (fn* [x acc] (cons (f x) acc)) () xs))) |
1ca3ee3d | 46 | (def! concat |
dcaf3f21 NB |
47 | (fn* [& xs] |
48 | (foldr (fn* [x acc] (foldr cons acc x)) () xs))) | |
1ca3ee3d | 49 | (def! conj |
9c20ca3f NB |
50 | (fn* [xs & ys] |
51 | (if (vector? xs) | |
fbfe6784 | 52 | (vec (concat xs ys)) |
dcaf3f21 | 53 | (reduce (fn* [acc x] (cons x acc)) xs ys)))) |
0544b52f | 54 | |
9c20ca3f | 55 | (def! do2 (fn* [& xs] (nth xs (- (count xs) 1)))) |
dcaf3f21 | 56 | (def! do3 (fn* [& xs] (reduce (fn* [_ x] x) nil xs))) |
9678065e NB |
57 | ;; do2 will probably be more efficient when lists are implemented as |
58 | ;; arrays with direct indexing, but when they are implemented as | |
59 | ;; linked lists, do3 may win because it only does one traversal. | |
0544b52f | 60 | |
dcaf3f21 NB |
61 | (defmacro! quote2 (fn* [ast] |
62 | (list (fn* [] ast)))) | |
9c20ca3f NB |
63 | (def! _quasiquote_iter (fn* [x acc] |
64 | (if (if (list? x) (= (first x) 'splice-unquote)) ; logical and | |
65 | (list 'concat (first (rest x)) acc) | |
dcaf3f21 NB |
66 | (list 'cons (list 'quasiquote2 x) acc)))) |
67 | (defmacro! quasiquote2 (fn* [ast] | |
9c20ca3f NB |
68 | (if (list? ast) |
69 | (if (= (first ast) 'unquote) | |
70 | (first (rest ast)) | |
71 | (foldr _quasiquote_iter () ast)) | |
72 | (if (vector? ast) | |
fbfe6784 | 73 | (list 'vec (foldr _quasiquote_iter () ast)) |
9c20ca3f NB |
74 | (list 'quote ast))))) |
75 | ||
dcaf3f21 NB |
76 | ;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns |
77 | ;; (f k1 v1 (f k2 v2 (f ... (f kn vn)))). | |
78 | (def! _foldr_pairs (fn* [f init kvs] | |
79 | (if (empty? kvs) | |
80 | init | |
81 | (let* [key (first kvs) | |
82 | rst (rest kvs) | |
83 | val (first rst) | |
84 | acc (_foldr_pairs f init (rest rst))] | |
85 | (f key val acc))))) | |
86 | (defmacro! let*A (fn* [binds form] | |
87 | (let* [formal (_foldr_pairs (fn* [key val acc] (cons key acc)) () binds) | |
88 | actual (_foldr_pairs (fn* [key val acc] (cons val acc)) () binds)] | |
89 | `((fn* ~formal ~form) ~@actual)))) | |
0f37b1af | 90 | ;; Fails for (let* [a 1 b (+ 1 a)] b) |
dcaf3f21 NB |
91 | (defmacro! let*B (fn* [binds form] |
92 | (let* [f (fn* [key val acc] | |
93 | `((fn* [~key] ~acc) ~val))] | |
94 | (_foldr_pairs f form binds)))) | |
0f37b1af | 95 | ;; Fails for (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1)) |
9c20ca3f NB |
96 | (def! _c_combinator (fn* [x] (x x))) |
97 | (def! _d_combinator (fn* [f] (fn* [x] (f (fn* [v] ((x x) v)))))) | |
0f37b1af | 98 | (def! _Y_combinator (fn* [x] (_c_combinator (_d_combinator x)))) |
dcaf3f21 NB |
99 | (defmacro! let*C (fn* [binds form] |
100 | (let* [f (fn* [key val acc] | |
101 | `((fn* [~key] ~acc) (_Y_combinator (fn* [~key] ~val))))] | |
102 | (_foldr_pairs f form binds)))) | |
0f37b1af NB |
103 | ;; Fails for mutual recursion. |
104 | ;; See http://okmij.org/ftp/Computation/fixed-point-combinators.html | |
105 | ;; if you are motivated to implement solution D. | |
7977c2cb | 106 | |
304930e7 | 107 | (def! apply |
1ca3ee3d NB |
108 | ;; Replace (f a b [c d]) with ('f 'a 'b 'c 'd) then evaluate the |
109 | ;; resulting function call (the surrounding environment does not | |
110 | ;; matter when evaluating a function call). | |
111 | ;; Use nil as marker to detect deepest recursive call. | |
112 | (let* [q (fn* [x] (list 'quote x)) | |
113 | iter (fn* [x acc] | |
114 | (if (nil? acc) ; x is the last element (a sequence) | |
115 | (map q x) | |
116 | (cons (q x) acc)))] | |
117 | (fn* [& xs] (eval (foldr iter nil xs))))) | |
9678065e | 118 | |
9c20ca3f NB |
119 | ;; Folds |
120 | ||
9678065e NB |
121 | (def! sum (fn* [xs] (reduce + 0 xs))) |
122 | (def! product (fn* [xs] (reduce * 1 xs))) | |
123 | ||
124 | (def! conjunction | |
125 | (let* [and2 (fn* [acc x] (if acc x false))] | |
126 | (fn* [xs] | |
127 | (reduce and2 true xs)))) | |
128 | (def! disjunction | |
129 | (let* [or2 (fn* [acc x] (if acc true x))] | |
130 | (fn* [xs] | |
131 | (reduce or2 false xs)))) | |
132 | ;; It would be faster to stop the iteration on first failure | |
133 | ;; (conjunction) or success (disjunction). Even better, `or` in the | |
134 | ;; stepA and `and` in `core.mal` stop evaluating their arguments. | |
135 | ||
136 | ;; Yes, -2-3-4 means (((0-2)-3)-4). | |
137 | ||
138 | ;; `(reduce str "" xs)` is equivalent to `apply str xs` | |
139 | ;; and `(reduce concat () xs)` is equivalent to `apply concat xs`. | |
140 | ;; The built-in iterations are probably faster. | |
141 | ||
142 | ;; `(reduce (fn* [acc _] acc) nil xs)` is equivalent to `nil`. | |
143 | ||
144 | ;; For (reduce (fn* [acc x] x) nil xs))), see do3 above. | |
145 | ||
146 | ;; `(reduce (fn* [acc x] (if (< acc x) x acc)) 0 xs)` computes the | |
147 | ;; maximum of a list of non-negative integers. It is hard to find an | |
148 | ;; initial value fitting all purposes. | |
149 | ||
150 | (def! sum_len | |
151 | (let* [add_len (fn* [acc x] (+ acc (count x)))] | |
152 | (fn* [xs] | |
9c20ca3f | 153 | (reduce add_len 0 xs)))) |
9678065e NB |
154 | (def! max_len |
155 | (let* [update_max (fn* [acc x] (let* [l (count x)] (if (< acc l) l acc)))] | |
156 | (fn* [xs] | |
157 | (reduce update_max 0 xs)))) | |
158 | ||
dcaf3f21 NB |
159 | ;; (fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs)) |
160 | ;; computes the composition of an arbitrary number of functions. | |
161 | ;; The first anonymous function is the mathematical composition. | |
162 | ;; For practical purposes, `->` and `->>` in `core.mal` are more | |
163 | ;; efficient and general. |