examples/exercises.mal

   1 ;; These are the answers to the questions in ../docs/exercise.md.
   2
   3 ;; In order to avoid unexpected circular dependencies among solutions,
   4 ;; this answer file attempts to be self-contained.
   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.
  11
  12 (def! nil?   (fn* [x] (= x nil  )))
  13 (def! true?  (fn* [x] (= x true )))
  14 (def! false? (fn* [x] (= x false)))
  15 (def! empty? (fn* [x] (= x []   )))
  16
  17 (def! sequential?
  18   (fn* [x]
  19     (if (list? x) true (vector? x))))
  20
  21 (def! >  (fn* [a b]      (< b a) ))
  22 (def! <= (fn* [a b] (not (< b a))))
  23 (def! >= (fn* [a b] (not (< a b))))
  24
  25 (def! list (fn* [& xs] xs))
  26 (def! vec (fn* [xs] (apply vector xs)))
  27 (def! prn (fn* [& xs] (println (apply pr-str xs))))
  28 (def! hash-map (fn* [& xs] (apply assoc {} xs)))
  29 (def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs))))
  30
  31 (def! count
  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"))))
  43 (def! map
  44   (fn* [f xs]
  45     (foldr (fn* [x acc] (cons (f x) acc)) () xs)))
  46 (def! concat
  47   (fn* [& xs]
  48     (foldr (fn* [x acc] (foldr cons acc x)) () xs)))
  49 (def! conj
  50   (fn* [xs & ys]
  51     (if (vector? xs)
  52       (vec (concat xs ys))
  53       (reduce (fn* [acc x] (cons x acc)) xs ys))))
  54
  55 (def! do2 (fn* [& xs] (nth xs (- (count xs) 1))))
  56 (def! do3 (fn* [& xs] (reduce (fn* [_ x] x) nil xs)))
  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.
  60
  61 (defmacro! quote2 (fn* [ast]
  62   (list (fn* [] ast))))
  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)
  66     (list 'cons (list 'quasiquote2 x) acc))))
  67 (defmacro! quasiquote2 (fn* [ast]
  68   (if (list? ast)
  69     (if (= (first ast) 'unquote)
  70       (first (rest ast))
  71       (foldr _quasiquote_iter () ast))
  72     (if (vector? ast)
  73       (list 'vec (foldr _quasiquote_iter () ast))
  74       (list 'quote ast)))))
  75
  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))))
  90 ;; Fails for (let* [a 1 b (+ 1 a)] b)
  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))))
  95 ;; Fails for (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1))
  96 (def! _c_combinator (fn* [x] (x x)))
  97 (def! _d_combinator (fn* [f] (fn* [x] (f (fn* [v] ((x x) v))))))
  98 (def! _Y_combinator (fn* [x] (_c_combinator (_d_combinator x))))
  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))))
 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.
 106
 107 (def! apply
 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)))))
 118
 119 ;; Folds
 120
 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]
 153       (reduce add_len 0 xs))))
 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
 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.