-;; FIXME lib/memoize.mal
-;; Memoize any function.
-
-;; Implement `memoize` using an atom (`mem`) which holds the memoized results
-;; (hash-map from the arguments to the result). When the function is called,
-;; the hash-map is checked to see if the result for the given argument was already
-;; calculated and stored. If this is the case, it is returned immediately;
-;; otherwise, it is calculated and stored in `mem`.
-
-;; Adapted from http://clojure.org/atoms
-
-(def! memoize
- (fn* [f]
- (let* [mem (atom {})]
- (fn* [& args]
- (let* [key (str args)]
- (if (contains? @mem key)
- (get @mem key)
- (let* [ret (apply f args)]
- (do
- (swap! mem assoc key ret)
- ret))))))))
-
-nil
-
-;; Benchmarks for memoize.mal
-
-(load-file "../lib/heavy_computations.mal") ; fib
-;; FIXME (load-file "../lib/memoize.mal")
-(load-file "../lib/perf.mal") ; time
-
-(def! N 32)
-
-;; Benchmark naive 'fib'
-
-(println "fib N=" N ": without memoization:")
-(time (fib N))
-;; "Elapsed time: 14402 msecs"
-
-
-;; Benchmark memoized 'fib'
-
-(def! fib (memoize fib))
-
-(println "fib N=" N ": with memoization:")
-(time (fib N))
-;; "Elapsed time: 1 msecs"
+;; Benchmarks for memoize.mal
+
+(load-file "../lib/heavy_computations.mal") ; fib
+(load-file "../lib/memoize.mal") ; memoize
+(load-file "../lib/perf.mal") ; time
+
+(def! N 32)
+
+;; Benchmark naive 'fib'
+
+(println "fib N=" N ": without memoization:")
+(time (fib N))
+;; "Elapsed time: 14402 msecs"
+
+
+;; Benchmark memoized 'fib'
+
+(def! fib (memoize fib))
+
+(println "fib N=" N ": with memoization:")
+(time (fib N))
+;; "Elapsed time: 1 msecs"
-;; FIXME lib/pprint.mal
-;; Pretty printer a MAL object.
-
-;; FIXME: hide these private routines in a private environment.
-
-(def! spaces- (fn* [indent]
- (if (> indent 0)
- (str " " (spaces- (- indent 1)))
- "")))
-
-(def! pp-seq- (fn* [obj indent]
- (let* [xindent (+ 1 indent)]
- (apply str (pp- (first obj) 0)
- (map (fn* [x] (str "\n" (spaces- xindent)
- (pp- x xindent)))
- (rest obj))))))
-
-(def! pp-map- (fn* [obj indent]
- (let* [ks (keys obj)
- kindent (+ 1 indent)
- kwidth (count (seq (str (first ks))))
- vindent (+ 1 (+ kwidth kindent))]
- (apply str (pp- (first ks) 0)
- " "
- (pp- (get obj (first ks)) 0)
- (map (fn* [k] (str "\n" (spaces- kindent)
- (pp- k kindent)
- " "
- (pp- (get obj k) vindent)))
- (rest (keys obj)))))))
-
-(def! pp- (fn* [obj indent]
- (cond
- (list? obj) (str "(" (pp-seq- obj indent) ")")
- (vector? obj) (str "[" (pp-seq- obj indent) "]")
- (map? obj) (str "{" (pp-map- obj indent) "}")
- :else (pr-str obj))))
-
-(def! pprint (fn* [obj]
- (println (pp- obj 0))))
-
-nil
-
-;; Examples of the pretty printer.
-
-;; FIXME (load-file "../lib/pprint.mal") and uncomment
-
-;;(pprint '(7 8 9 "ten" [11 12 [13 14]] 15 16))
-;;(pprint '{:abc 123 :def {:ghi 456 :jkl [789 "ten eleven twelve"]}})
-;;(pprint '(7 8 {:abc 123 :def {:ghi 456 :jkl 789}} 9 10 [11 12 [13 14]] 15 16))
+;; Examples of the pretty printer.
+
+(load-file "../lib/pprint.mal") ; pprint
+
+(pprint '(7 8 9 "ten" [11 12 [13 14]] 15 16))
+(pprint '{:abc 123 :def {:ghi 456 :jkl [789 "ten eleven twelve"]}})
+(pprint '(7 8 {:abc 123 :def {:ghi 456 :jkl 789}} 9 10 [11 12 [13 14]] 15 16))
-;; FIXME lib/memoize.mal
-;; A sketch of Clojure-like protocols, implemented in Mal
-;; By chouser (Chris Houser)
-;; Original: https://gist.github.com/Chouser/6081ea66d144d13e56fc
-
-(def! builtin-type (fn* [obj]
- (cond
- (list? obj) :mal/list
- (vector? obj) :mal/vector
- (map? obj) :mal/map
- (symbol? obj) :mal/symbol
- (keyword? obj) :mal/keyword
- (atom? obj) :mal/atom
- (nil? obj) nil
- (true? obj) :mal/bool
- (false? obj) :mal/bool)))
-
-(def! find-protocol-methods (fn* [protocol obj]
- (let* [p @protocol]
- (or (get p (get (meta obj) :type))
- (get p (builtin-type obj))
- (get p :mal/default)))))
-
-(def! satisfies? (fn* [protocol obj]
- (if (find-protocol-methods protocol obj) true false)))
-
-(defmacro! defprotocol (fn* [proto-name & methods]
- `(do
- (def! ~proto-name (atom {}))
- ~@(map (fn* [m]
- (let* [name (first m), sig (first (rest m))]
- `(def! ~name (fn* [this-FIXME & args-FIXME]
- (apply (get (find-protocol-methods ~proto-name this-FIXME)
- ~(keyword (str name)))
- this-FIXME args-FIXME)))))
- methods))))
-
-(def! extend (fn* [type proto methods & more]
- (do
- (swap! proto assoc type methods)
- (if (first more)
- (apply extend type more)))))
-
-nil
-
-;; Examples for protocols.
-
-;; FIXME (load-file "../lib/protocols.mal")
-
-(def! make-triangle (fn* [o a]
- ^{:type :shape/triangle} {:opposite o, :adjacent a}))
-
-(def! make-rectangle (fn* [x y]
- ^{:type :shape/rectangle} {:width x, :height y}))
-
-(defprotocol IDraw
- (area [this])
- (draw [this]))
-
-(prn :false-> (satisfies? IDraw (make-triangle 5 5))) ;=> false
-
-(extend :shape/rectangle
- IDraw
- {:area (fn* [obj] (* (get obj :width) (get obj :height)))
- :draw (fn* [obj] (println "[]"))})
-
-(extend :shape/triangle
- IDraw
- {:area (fn* [obj] (/ (* (get obj :opposite) (get obj :adjacent)) 2))
- :draw (fn* [obj] (println " .\n.."))})
-
-(prn :true-> (satisfies? IDraw (make-triangle 5 5))) ;=> true
-
-(prn :area-> (area (make-triangle 5 4))) ;=> 10
+;; Examples for protocols.
+
+(load-file "../lib/protocols.mal") ; defprotocol extend satisfies
+
+(def! make-triangle (fn* [o a]
+ ^{:type :shape/triangle} {:opposite o, :adjacent a}))
+
+(def! make-rectangle (fn* [x y]
+ ^{:type :shape/rectangle} {:width x, :height y}))
+
+(defprotocol IDraw
+ (area [this])
+ (draw [this]))
+
+(prn :false-> (satisfies? IDraw (make-triangle 5 5))) ;=> false
+
+(extend :shape/rectangle
+ IDraw
+ {:area (fn* [obj] (* (get obj :width) (get obj :height)))
+ :draw (fn* [obj] (println "[]"))})
+
+(extend :shape/triangle
+ IDraw
+ {:area (fn* [obj] (/ (* (get obj :opposite) (get obj :adjacent)) 2))
+ :draw (fn* [obj] (println " .\n.."))})
+
+(prn :true-> (satisfies? IDraw (make-triangle 5 5))) ;=> true
+
+(prn :area-> (area (make-triangle 5 4))) ;=> 10
--- /dev/null
+;; Composition of partially applied functions.
+
+(load-file "../lib/folds.mal") ; reduce
+
+;; Rewrite x (a a1 a2) .. (b b1 b2) as
+;; (b (.. (a x a1 a2) ..) b1 b2)
+;; If anything else than a list is found were `(a a1 a2)` is expected,
+;; replace it with a list with one element, so that `-> x a` is
+;; equivalent to `-> x (list a)`.
+(defmacro! ->
+ (fn* (x & xs)
+ ;; FIXME define this only once
+ (let* [f (fn* [acc form]
+ (if (list? form)
+ `(~(first form) ~acc ~@(rest form))
+ (list form acc)))]
+ (reduce f x xs))))
+
+;; Like `->`, but the arguments describe functions that are partially
+;; applied with *left* arguments. The previous result is inserted at
+;; the *end* of the new argument list.
+;; Rewrite x ((a a1 a2) .. (b b1 b2)) as
+;; (b b1 b2 (.. (a a1 a2 x) ..)).
+(defmacro! ->>
+ (fn* (x & xs)
+ ;; FIXME define this only once
+ (let* [f (fn* [acc form]
+ (if (list? form)
+ `(~(first form) ~@(rest form) ~acc)
+ (list form acc)))]
+ (reduce f x xs))))
+
+nil
+++ /dev/null
-;; FIXME: trivial.mal
-;; Trivial but convenient functions.
-
-;; Integer predecessor (number -> number)
-(def! dec (fn* (a) (- a 1)))
-
-;; Integer nullity test (number -> boolean)
-(def! zero? (fn* (n) (= 0 n)))
-
-;; FIXME: folds.mal
-;; Left and right folds.
-
-;; Left fold (f (.. (f (f init x1) x2) ..) xn)
-(def! reduce
- (fn* (f init xs)
- ;; f : Accumulator Element -> Accumulator
- ;; init : Accumulator
- ;; xs : sequence of Elements x1 x2 .. xn
- ;; return : Accumulator
- (if (empty? xs)
- init
- (reduce f (f init (first xs)) (rest xs)))))
-
-;; Right fold (f x1 (f x2 (.. (f xn init)) ..))
-;; The natural implementation for `foldr` is not tail-recursive, so we
-;; rely on efficient `nth` and `count`.
-(def! foldr
- (fn* [f init xs]
- ;; f : Element Accumulator -> Accumulator
- ;; init : Accumulator
- ;; xs : sequence of Elements x1 x2 .. xn
- ;; return : Accumulator
- ;; FIXME: pass f and xs and build this only once in a private env
- (let* [rec (fn* [acc index]
- (if (< index 0)
- acc
- (rec (f (nth xs index) acc) (dec index))))]
- ;; FIXME stop using dec or load trivial.mal
- (rec init (dec (count xs))))))
-
-nil
-
-;; FIXME: lib/trivial.mal
-;; Returns the unchanged argument.
-(def! identity (fn* (x) x))
-
-;; FIXME: test_cascade.mal
-;; Iteration on evaluations interpreted as boolean values.
-
-;; Conjonction of predicate values (pred x1) and .. and (pred xn)
-;; Evaluate `pred x` for each `x` in turn. Return `false` if a result
-;; is `nil` or `false`, without evaluating the predicate for the
-;; remaining elements. If all test pass, return `true`.
-(def! every?
- (fn* (pred xs)
- ;; pred : Element -> interpreted as a logical value
- ;; xs : sequence of Elements x1 x2 .. xn
- ;; return : boolean
- ;; FIXME: use cond
- (if (empty? xs)
- true
- (if (pred (first xs))
- (every? pred (rest xs))
- false))))
-
-;; Disjonction of predicate values (pred x1) or .. (pred xn)
-;; Evaluate `(pred x)` for each `x` in turn. Return the first result
-;; that is neither `nil` nor `false`, without evaluating the predicate
-;; for the remaining elements. If all tests fail, return nil.
-(def! some
- (fn* (pred xs)
- ;; pred : Element -> interpreted as a logical value
- ;; xs : sequence of Elements x1 x2 .. xn
- ;; return : boolean
- (if (empty? xs)
- nil
- ;; FIXME use or
- (let* (res (pred (first xs)))
- (if res
- res
- (some pred (rest xs)))))))
-
-;; Search for first evaluation returning `nil` or `false`.
-;; Rewrite `x1 x2 .. xn x` as
-;; (let* [r1 x1]
-;; (if r1 test1
-;; (let* [r2 x2]
-;; ..
-;; (if rn
-;; x
-;; rn) ..)
-;; r1))
-;; Without arguments, returns `true`.
-(defmacro! and
- (fn* (& xs)
- ;; Arguments and the result are interpreted as boolean values.
- ;; FIXME: use cond
- (if (empty? xs)
- true
- (if (= 1 (count xs))
- (first xs)
- (let* (condvar (gensym))
- `(let* (~condvar ~(first xs))
- (if ~condvar (and ~@(rest xs)) ~condvar)))))))
-
-;; FIXME: composition.mal
-;; Composition of partially applied functions.
-
-;; FIXME (load-file "../lib/folds.mal") ; reduce
-
-;; Rewrite x (a a1 a2) .. (b b1 b2) as
-;; (b (.. (a x a1 a2) ..) b1 b2)
-;; If anything else than a list is found were `(a a1 a2)` is expected,
-;; replace it with a list with one element, so that `-> x a` is
-;; equivalent to `-> x (list a)`.
-(defmacro! ->
- (fn* (x & xs)
- ;; FIXME define this only once
- (let* [f (fn* [acc form]
- (if (list? form)
- `(~(first form) ~acc ~@(rest form))
- (list form acc)))]
- (reduce f x xs))))
-
-;; Like `->`, but the arguments describe functions that are partially
-;; applied with *left* arguments. The previous result is inserted at
-;; the *end* of the new argument list.
-;; Rewrite x ((a a1 a2) .. (b b1 b2)) as
-;; (b b1 b2 (.. (a a1 a2 x) ..)).
-(defmacro! ->>
- (fn* (x & xs)
- ;; FIXME define this only once
- (let* [f (fn* [acc form]
- (if (list? form)
- `(~(first form) ~@(rest form) ~acc)
- (list form acc)))]
- (reduce f x xs))))
-
-nil
--- /dev/null
+;; Left and right folds.
+
+;; Left fold (f (.. (f (f init x1) x2) ..) xn)
+(def! reduce
+ (fn* (f init xs)
+ ;; f : Accumulator Element -> Accumulator
+ ;; init : Accumulator
+ ;; xs : sequence of Elements x1 x2 .. xn
+ ;; return : Accumulator
+ (if (empty? xs)
+ init
+ (reduce f (f init (first xs)) (rest xs)))))
+
+;; Right fold (f x1 (f x2 (.. (f xn init)) ..))
+;; The natural implementation for `foldr` is not tail-recursive, so we
+;; rely on efficient `nth` and `count`.
+(def! foldr
+ (fn* [f init xs]
+ ;; f : Element Accumulator -> Accumulator
+ ;; init : Accumulator
+ ;; xs : sequence of Elements x1 x2 .. xn
+ ;; return : Accumulator
+ ;; FIXME: pass f and xs and build this only once in a private env
+ (let* [rec (fn* [acc index]
+ (if (< index 0)
+ acc
+ (rec (f (nth xs index) acc) (dec index))))]
+ ;; FIXME stop using dec or load trivial.mal
+ (rec init (dec (count xs))))))
+
+nil
-;; FIXME lib/memoize.mal
;; Memoize any function.
;; Implement `memoize` using an atom (`mem`) which holds the memoized results
ret))))))))
nil
-
-;; Benchmarks for memoize.mal
-
-(load-file "../lib/heavy_computations.mal") ; fib
-;; FIXME (load-file "../lib/memoize.mal")
-(load-file "../lib/perf.mal") ; time
-
-(def! N 32)
-
-;; Benchmark naive 'fib'
-
-(println "fib N=" N ": without memoization:")
-(time (fib N))
-;; "Elapsed time: 14402 msecs"
-
-
-;; Benchmark memoized 'fib'
-
-(def! fib (memoize fib))
-
-(println "fib N=" N ": with memoization:")
-(time (fib N))
-;; "Elapsed time: 1 msecs"
-;; FIXME lib/pprint.mal
;; Pretty printer a MAL object.
;; FIXME: hide these private routines in a private environment.
(println (pp- obj 0))))
nil
-
-;; Examples of the pretty printer.
-
-;; FIXME (load-file "../lib/pprint.mal") and uncomment
-
-;;(pprint '(7 8 9 "ten" [11 12 [13 14]] 15 16))
-;;(pprint '{:abc 123 :def {:ghi 456 :jkl [789 "ten eleven twelve"]}})
-;;(pprint '(7 8 {:abc 123 :def {:ghi 456 :jkl 789}} 9 10 [11 12 [13 14]] 15 16))
-;; FIXME lib/memoize.mal
;; A sketch of Clojure-like protocols, implemented in Mal
+
;; By chouser (Chris Houser)
;; Original: https://gist.github.com/Chouser/6081ea66d144d13e56fc
(apply extend type more)))))
nil
-
-;; Examples for protocols.
-
-;; FIXME (load-file "../lib/protocols.mal")
-
-(def! make-triangle (fn* [o a]
- ^{:type :shape/triangle} {:opposite o, :adjacent a}))
-
-(def! make-rectangle (fn* [x y]
- ^{:type :shape/rectangle} {:width x, :height y}))
-
-(defprotocol IDraw
- (area [this])
- (draw [this]))
-
-(prn :false-> (satisfies? IDraw (make-triangle 5 5))) ;=> false
-
-(extend :shape/rectangle
- IDraw
- {:area (fn* [obj] (* (get obj :width) (get obj :height)))
- :draw (fn* [obj] (println "[]"))})
-
-(extend :shape/triangle
- IDraw
- {:area (fn* [obj] (/ (* (get obj :opposite) (get obj :adjacent)) 2))
- :draw (fn* [obj] (println " .\n.."))})
-
-(prn :true-> (satisfies? IDraw (make-triangle 5 5))) ;=> true
-
-(prn :area-> (area (make-triangle 5 4))) ;=> 10
--- /dev/null
+;; Iteration on evaluations interpreted as boolean values.
+
+;; Conjonction of predicate values (pred x1) and .. and (pred xn)
+;; Evaluate `pred x` for each `x` in turn. Return `false` if a result
+;; is `nil` or `false`, without evaluating the predicate for the
+;; remaining elements. If all test pass, return `true`.
+(def! every?
+ (fn* (pred xs)
+ ;; pred : Element -> interpreted as a logical value
+ ;; xs : sequence of Elements x1 x2 .. xn
+ ;; return : boolean
+ ;; FIXME: use cond
+ (if (empty? xs)
+ true
+ (if (pred (first xs))
+ (every? pred (rest xs))
+ false))))
+
+;; Disjonction of predicate values (pred x1) or .. (pred xn)
+;; Evaluate `(pred x)` for each `x` in turn. Return the first result
+;; that is neither `nil` nor `false`, without evaluating the predicate
+;; for the remaining elements. If all tests fail, return nil.
+(def! some
+ (fn* (pred xs)
+ ;; pred : Element -> interpreted as a logical value
+ ;; xs : sequence of Elements x1 x2 .. xn
+ ;; return : boolean
+ (if (empty? xs)
+ nil
+ ;; FIXME use or
+ (let* (res (pred (first xs)))
+ (if res
+ res
+ (some pred (rest xs)))))))
+
+;; Search for first evaluation returning `nil` or `false`.
+;; Rewrite `x1 x2 .. xn x` as
+;; (let* [r1 x1]
+;; (if r1 test1
+;; (let* [r2 x2]
+;; ..
+;; (if rn
+;; x
+;; rn) ..)
+;; r1))
+;; Without arguments, returns `true`.
+(defmacro! and
+ (fn* (& xs)
+ ;; Arguments and the result are interpreted as boolean values.
+ ;; FIXME: use cond
+ (if (empty? xs)
+ true
+ (if (= 1 (count xs))
+ (first xs)
+ (let* (condvar (gensym))
+ `(let* (~condvar ~(first xs))
+ (if ~condvar (and ~@(rest xs)) ~condvar)))))))
+
+nil
--- /dev/null
+;; Trivial but convenient functions.
+
+;; Integer predecessor (number -> number)
+(def! dec (fn* (a) (- a 1)))
+
+;; Integer nullity test (number -> boolean)
+(def! zero? (fn* (n) (= 0 n)))
+
+;; Returns the unchanged argument.
+(def! identity (fn* (x) x))
+
+nil
HCoop / jackhill / mal.git / commitdiff