kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-08-16 09:10:48 +03:00
Code Issues Projects Releases Wiki Activity

lib/: perform file splits, without change in contents

Browse Source
This commit is contained in:
Nicolas Boulenguez 2019-05-15 15:06:26 +02:00
parent 3e9b89d4b5
commit dcdb6c029e
11 changed files with 250 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
examples/memoize.mal
View File

@ -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)

51
examples/pprint.mal
View File

@ -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))

47
examples/protocols.mal
View File

@ -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
View 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
View File

@ -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
View 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
View 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
View 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
View 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
View 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
View 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