mirror of
https://github.com/kanaka/mal.git
synced 2024-09-11 13:55:55 +03:00
lib/: perform file splits, without change in contents
This commit is contained in:
parent
3e9b89d4b5
commit
dcdb6c029e
@ -1,33 +1,8 @@
|
||||
;; 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
|
||||
(load-file "../lib/memoize.mal") ; memoize
|
||||
(load-file "../lib/perf.mal") ; time
|
||||
|
||||
(def! N 32)
|
||||
|
||||
|
@ -1,50 +1,7 @@
|
||||
;; 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
|
||||
(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))
|
||||
(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))
|
||||
|
@ -1,51 +1,6 @@
|
||||
;; 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")
|
||||
(load-file "../lib/protocols.mal") ; defprotocol extend satisfies
|
||||
|
||||
(def! make-triangle (fn* [o a]
|
||||
^{:type :shape/triangle} {:opposite o, :adjacent a}))
|
||||
|
33
lib/composition.mal
Normal file
33
lib/composition.mal
Normal file
@ -0,0 +1,33 @@
|
||||
;; 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
|
139
lib/core.mal
139
lib/core.mal
@ -1,139 +0,0 @@
|
||||
;; 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
|
31
lib/folds.mal
Normal file
31
lib/folds.mal
Normal file
@ -0,0 +1,31 @@
|
||||
;; 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
|
23
lib/memoize.mal
Normal file
23
lib/memoize.mal
Normal file
@ -0,0 +1,23 @@
|
||||
;; 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
|
41
lib/pprint.mal
Normal file
41
lib/pprint.mal
Normal file
@ -0,0 +1,41 @@
|
||||
;; 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
|
44
lib/protocols.mal
Normal file
44
lib/protocols.mal
Normal file
@ -0,0 +1,44 @@
|
||||
;; 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
|
59
lib/test_cascade.mal
Normal file
59
lib/test_cascade.mal
Normal file
@ -0,0 +1,59 @@
|
||||
;; 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
|
12
lib/trivial.mal
Normal file
12
lib/trivial.mal
Normal file
@ -0,0 +1,12 @@
|
||||
;; 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
|
Loading…
Reference in New Issue
Block a user