mirror of
https://github.com/kanaka/mal.git
synced 2024-09-19 17:47:53 +03:00
Merge pull request #371 from asarhaddon/extend-core.mal
Extend core.mal
This commit is contained in:
commit
a4cb289ffb
66
core.mal
66
core.mal
@ -1,66 +0,0 @@
|
|||||||
(def! dec (fn* (a) (- a 1)))
|
|
||||||
|
|
||||||
(def! zero? (fn* (n) (= 0 n)))
|
|
||||||
|
|
||||||
(def! reduce
|
|
||||||
(fn* (f init xs)
|
|
||||||
(if (empty? xs)
|
|
||||||
init
|
|
||||||
(reduce f (f init (first xs)) (rest xs)))))
|
|
||||||
|
|
||||||
(def! identity (fn* (x) x))
|
|
||||||
|
|
||||||
(def! every?
|
|
||||||
(fn* (pred xs)
|
|
||||||
(if (empty? xs)
|
|
||||||
true
|
|
||||||
(if (pred (first xs))
|
|
||||||
(every? pred (rest xs))
|
|
||||||
false))))
|
|
||||||
|
|
||||||
(def! some
|
|
||||||
(fn* (pred xs)
|
|
||||||
(if (empty? xs)
|
|
||||||
nil
|
|
||||||
(let* (res (pred (first xs)))
|
|
||||||
(if res
|
|
||||||
res
|
|
||||||
(some pred (rest xs)))))))
|
|
||||||
|
|
||||||
(defmacro! and
|
|
||||||
(fn* (& xs)
|
|
||||||
(if (empty? xs)
|
|
||||||
true
|
|
||||||
(if (= 1 (count xs))
|
|
||||||
(first xs)
|
|
||||||
(let* (condvar (gensym))
|
|
||||||
`(let* (~condvar ~(first xs))
|
|
||||||
(if ~condvar (and ~@(rest xs)) ~condvar)))))))
|
|
||||||
|
|
||||||
(defmacro! ->
|
|
||||||
(fn* (x & xs)
|
|
||||||
(if (empty? xs)
|
|
||||||
x
|
|
||||||
(let* (form (first xs)
|
|
||||||
more (rest xs))
|
|
||||||
(if (empty? more)
|
|
||||||
(if (list? form)
|
|
||||||
`(~(first form) ~x ~@(rest form))
|
|
||||||
(list form x))
|
|
||||||
`(-> (-> ~x ~form) ~@more))))))
|
|
||||||
|
|
||||||
(defmacro! ->>
|
|
||||||
(fn* (x & xs)
|
|
||||||
(if (empty? xs)
|
|
||||||
x
|
|
||||||
(let* (form (first xs)
|
|
||||||
more (rest xs))
|
|
||||||
(if (empty? more)
|
|
||||||
(if (list? form)
|
|
||||||
`(~(first form) ~@(rest form) ~x)
|
|
||||||
(list form x))
|
|
||||||
`(->> (->> ~x ~form) ~@more))))))
|
|
||||||
|
|
||||||
; This `nil` is intentional so that the result of doing `load-file` is
|
|
||||||
; `nil` instead of whatever happens to be at the end of `core.mal`.
|
|
||||||
nil
|
|
@ -5,9 +5,7 @@ Then refresh the .png files.
|
|||||||
|
|
||||||
General:
|
General:
|
||||||
- add chat bot for #mal
|
- add chat bot for #mal
|
||||||
- move tokenizer.mal and reader.mal from malc along with
|
- move tokenizer.mal and reader.mal from malc to ./lib directory
|
||||||
./examples/{equality,memoize,pprint,protocols}.mal and
|
|
||||||
./core.mal to ./lib directory
|
|
||||||
|
|
||||||
- Finish guide.md
|
- Finish guide.md
|
||||||
- mention that identifier names are suggested. some have run
|
- mention that identifier names are suggested. some have run
|
||||||
|
@ -1,41 +0,0 @@
|
|||||||
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
|
|
||||||
;;(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,70 +0,0 @@
|
|||||||
;; 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)))))
|
|
||||||
|
|
||||||
;;----
|
|
||||||
;; Example:
|
|
||||||
|
|
||||||
(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
|
|
29
lib/README.md
Normal file
29
lib/README.md
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
This directory contains general-purpose reusable code that does not
|
||||||
|
fit in the process.
|
||||||
|
|
||||||
|
The split in small files is motivated by implementations too limited
|
||||||
|
to load a single big file, but MAL has no proper module management.
|
||||||
|
|
||||||
|
However, here are some guidelines.
|
||||||
|
|
||||||
|
- Begin with an one-line ;; short description
|
||||||
|
|
||||||
|
- End with `nil`, so that the result of `load-file` is conveniently
|
||||||
|
short when loading manually and predictilbe for automatic testing
|
||||||
|
|
||||||
|
- Describe the restrictions on each parameter in comments.
|
||||||
|
|
||||||
|
- Define private symbols in hidden environments when possible. If this
|
||||||
|
is not possible, for example for macros, give them a name starting
|
||||||
|
with an underscore.
|
||||||
|
|
||||||
|
- Support successive imports safely by giving the same definitions
|
||||||
|
again.
|
||||||
|
|
||||||
|
If a module provides tests, you may run against an implementation IMPL
|
||||||
|
with these commands.
|
||||||
|
```
|
||||||
|
make IMPL^stepA
|
||||||
|
cd tests
|
||||||
|
python ../runtest.py lib/MODULE.mal ../IMPL/run
|
||||||
|
```
|
@ -1,60 +1,58 @@
|
|||||||
;;
|
|
||||||
;; equality.mal
|
;; equality.mal
|
||||||
;;
|
|
||||||
;; This file checks whether the `=` function correctly implements equality of
|
;; This file checks whether the `=` function correctly implements equality of
|
||||||
;; hash-maps and sequences (lists and vectors). If not, it redefines the `=`
|
;; hash-maps and sequences (lists and vectors). If not, it redefines the `=`
|
||||||
;; function with a pure mal (recursive) implementation that only relies on the
|
;; function with a pure mal (recursive) implementation that only relies on the
|
||||||
;; native original `=` function for comparing scalars (integers, booleans,
|
;; native original `=` function for comparing scalars (integers, booleans,
|
||||||
;; symbols, strings).
|
;; symbols, strings, keywords, atoms, nil).
|
||||||
;;
|
|
||||||
|
|
||||||
;; Save the original (native) `=` as scalar-equal?
|
;; Save the original (native) `=` as scalar-equal?
|
||||||
(def! scalar-equal? =)
|
(def! scalar-equal? =)
|
||||||
|
|
||||||
;; A simple `and` macro for two argument which doesn't use `=` internally
|
;; A faster `and` macro which doesn't use `=` internally.
|
||||||
(defmacro! and2
|
(defmacro! and2 ; boolean
|
||||||
(fn* [a b]
|
(fn* [& xs] ; interpreted as logical values
|
||||||
`(let* (and2_FIXME ~a)
|
(if (empty? xs)
|
||||||
(if and2_FIXME ~b and2_FIXME))))
|
true
|
||||||
|
`(if ~(first xs) (and2 ~@(rest xs)) false))))
|
||||||
|
(defmacro! or2 ; boolean
|
||||||
|
(fn* [& xs] ; interpreted as logical values
|
||||||
|
(if (empty? xs)
|
||||||
|
false
|
||||||
|
`(if ~(first xs) true (or2 ~@(rest xs))))))
|
||||||
|
|
||||||
;; Implement `=` for two sequential arguments
|
(def! starts-with?
|
||||||
(def! sequential-equal?
|
|
||||||
(fn* [a b]
|
(fn* [a b]
|
||||||
(if (scalar-equal? (count a) (count b))
|
(or2 (empty? a)
|
||||||
(if (empty? a)
|
(and2 (mal-equal? (first a) (first b))
|
||||||
true
|
(starts-with? (rest a) (rest b))))))
|
||||||
(if (mal-equal? (first a) (first b))
|
|
||||||
(sequential-equal? (rest a) (rest b))
|
|
||||||
false))
|
|
||||||
false)))
|
|
||||||
|
|
||||||
;; Helper function
|
|
||||||
(def! hash-map-vals-equal?
|
(def! hash-map-vals-equal?
|
||||||
(fn* [a b map-keys]
|
(fn* [a b map-keys]
|
||||||
(if (scalar-equal? 0 (count map-keys))
|
(or2 (empty? map-keys)
|
||||||
true
|
(let* [key (first map-keys)]
|
||||||
(let* [key (first map-keys)]
|
(and2 (contains? b key)
|
||||||
(if (and2
|
(mal-equal? (get a key) (get b key))
|
||||||
(and2 (contains? a key) (contains? b key))
|
(hash-map-vals-equal? a b (rest map-keys)))))))
|
||||||
(mal-equal? (get a key) (get b key)))
|
|
||||||
(hash-map-vals-equal? a b (rest map-keys))
|
|
||||||
false)))))
|
|
||||||
|
|
||||||
;; Implement `=` for two hash-maps
|
|
||||||
(def! hash-map-equal?
|
|
||||||
(fn* [a b]
|
|
||||||
(let* [keys-a (keys a)]
|
|
||||||
(if (scalar-equal? (count keys-a) (count (keys b)))
|
|
||||||
(hash-map-vals-equal? a b keys-a)
|
|
||||||
false))))
|
|
||||||
|
|
||||||
;; This implements = in pure mal (using only scalar-equal? as native impl)
|
;; This implements = in pure mal (using only scalar-equal? as native impl)
|
||||||
(def! mal-equal?
|
(def! mal-equal?
|
||||||
(fn* [a b]
|
(fn* [a b]
|
||||||
(cond
|
(cond
|
||||||
(and2 (sequential? a) (sequential? b)) (sequential-equal? a b)
|
|
||||||
(and2 (map? a) (map? b)) (hash-map-equal? a b)
|
(sequential? a)
|
||||||
true (scalar-equal? a b))))
|
(and2 (sequential? b)
|
||||||
|
(scalar-equal? (count a) (count b))
|
||||||
|
(starts-with? a b))
|
||||||
|
|
||||||
|
(map? a)
|
||||||
|
(let* [keys-a (keys a)]
|
||||||
|
(and2 (map? b)
|
||||||
|
(scalar-equal? (count keys-a) (count (keys b)))
|
||||||
|
(hash-map-vals-equal? a b keys-a)))
|
||||||
|
|
||||||
|
true
|
||||||
|
(scalar-equal? a b))))
|
||||||
|
|
||||||
(def! hash-map-equality-correct?
|
(def! hash-map-equality-correct?
|
||||||
(fn* []
|
(fn* []
|
||||||
@ -76,3 +74,5 @@
|
|||||||
(do
|
(do
|
||||||
(def! = mal-equal?)
|
(def! = mal-equal?)
|
||||||
(println "equality.mal: Replaced = with pure mal implementation")))
|
(println "equality.mal: Replaced = with pure mal implementation")))
|
||||||
|
|
||||||
|
nil
|
@ -1,16 +1,17 @@
|
|||||||
;;
|
;; Memoize any function.
|
||||||
;; memoize.mal
|
|
||||||
;;
|
|
||||||
;; Implement `memoize` using an atom (`mem`) which holds the memoized results
|
;; Implement `memoize` using an atom (`mem`) which holds the memoized results
|
||||||
;; (hash-map from the arguments to the result). When the function is called,
|
;; (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
|
;; 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;
|
;; calculated and stored. If this is the case, it is returned immediately;
|
||||||
;; otherwise, it is calculated and stored in `mem`.
|
;; otherwise, it is calculated and stored in `mem`.
|
||||||
;;
|
|
||||||
;; Adapted from http://clojure.org/atoms
|
|
||||||
;;
|
|
||||||
|
|
||||||
;; Memoize any function
|
;; For recursive functions, take care to store the wrapper under the
|
||||||
|
;; same name than the original computation with an assignment like
|
||||||
|
;; `(def! f (memoize f))`, so that intermediate results are memorized.
|
||||||
|
|
||||||
|
;; Adapted from http://clojure.org/atoms
|
||||||
|
|
||||||
(def! memoize
|
(def! memoize
|
||||||
(fn* [f]
|
(fn* [f]
|
||||||
(let* [mem (atom {})]
|
(let* [mem (atom {})]
|
||||||
@ -23,31 +24,4 @@
|
|||||||
(swap! mem assoc key ret)
|
(swap! mem assoc key ret)
|
||||||
ret))))))))
|
ret))))))))
|
||||||
|
|
||||||
;; Naive (non-memoized) Fibonacci function
|
nil
|
||||||
(def! fib
|
|
||||||
(fn* [n]
|
|
||||||
(if (<= n 1)
|
|
||||||
n
|
|
||||||
(+ (fib (- n 1)) (fib (- n 2))))))
|
|
||||||
|
|
||||||
|
|
||||||
;; -----------------------------------------------
|
|
||||||
;; Benchmarks
|
|
||||||
|
|
||||||
(load-file "../perf.mal") ; for the 'time' macro
|
|
||||||
(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"
|
|
40
lib/perf.mal
Normal file
40
lib/perf.mal
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
;; Mesure performances.
|
||||||
|
|
||||||
|
;; Evaluate an expression, but report the time spent
|
||||||
|
(defmacro! time
|
||||||
|
(fn* (exp)
|
||||||
|
(let* [start (gensym)
|
||||||
|
ret (gensym)]
|
||||||
|
`(let* [~start (time-ms)
|
||||||
|
~ret ~exp]
|
||||||
|
(do
|
||||||
|
(prn (str "Elapsed time: " (- (time-ms) ~start) " msecs"))
|
||||||
|
~ret)))))
|
||||||
|
|
||||||
|
;; Count evaluations of a function during a given time frame.
|
||||||
|
(def! run-fn-for
|
||||||
|
|
||||||
|
(let* [
|
||||||
|
run-fn-for* (fn* [fn max-ms acc-ms last-iters]
|
||||||
|
(let* [start (time-ms)
|
||||||
|
_ (fn)
|
||||||
|
elapsed (- (time-ms) start)
|
||||||
|
iters (+ 1 last-iters)
|
||||||
|
new-acc-ms (+ acc-ms elapsed)]
|
||||||
|
;; (do (prn "new-acc-ms:" new-acc-ms "iters:" iters))
|
||||||
|
(if (>= new-acc-ms max-ms)
|
||||||
|
last-iters
|
||||||
|
(run-fn-for* fn max-ms new-acc-ms iters))))
|
||||||
|
]
|
||||||
|
|
||||||
|
(fn* [fn max-secs]
|
||||||
|
;; fn : function without parameters
|
||||||
|
;; max-secs : number (seconds)
|
||||||
|
;; return : number (iterations)
|
||||||
|
(do
|
||||||
|
;; Warm it up first
|
||||||
|
(run-fn-for* fn 1000 0 0)
|
||||||
|
;; Now do the test
|
||||||
|
(run-fn-for* fn (* 1000 max-secs) 0 0)))))
|
||||||
|
|
||||||
|
nil
|
45
lib/pprint.mal
Normal file
45
lib/pprint.mal
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
;; Pretty printer a MAL object.
|
||||||
|
|
||||||
|
(def! pprint
|
||||||
|
|
||||||
|
(let* [
|
||||||
|
|
||||||
|
spaces- (fn* [indent]
|
||||||
|
(if (> indent 0)
|
||||||
|
(str " " (spaces- (- indent 1)))
|
||||||
|
""))
|
||||||
|
|
||||||
|
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)))))
|
||||||
|
|
||||||
|
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))))))
|
||||||
|
|
||||||
|
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)))
|
||||||
|
|
||||||
|
]
|
||||||
|
|
||||||
|
(fn* [obj]
|
||||||
|
(println (pp- obj 0)))))
|
||||||
|
|
||||||
|
nil
|
97
lib/protocols.mal
Normal file
97
lib/protocols.mal
Normal file
@ -0,0 +1,97 @@
|
|||||||
|
;; A sketch of Clojure-like protocols, implemented in Mal
|
||||||
|
|
||||||
|
;; By chouser (Chris Houser)
|
||||||
|
;; Original: https://gist.github.com/Chouser/6081ea66d144d13e56fc
|
||||||
|
|
||||||
|
;; This function maps a MAL value to a keyword representing its type.
|
||||||
|
;; Most applications will override the default with an explicit value
|
||||||
|
;; for the `:type` key in the metadata.
|
||||||
|
(def! find-type (fn* [obj]
|
||||||
|
(cond
|
||||||
|
(symbol? obj) :mal/symbol
|
||||||
|
(keyword? obj) :mal/keyword
|
||||||
|
(atom? obj) :mal/atom
|
||||||
|
(nil? obj) :mal/nil
|
||||||
|
(true? obj) :mal/boolean
|
||||||
|
(false? obj) :mal/boolean
|
||||||
|
(number? obj) :mal/number
|
||||||
|
(string? obj) :mal/string
|
||||||
|
(macro? obj) :mal/macro
|
||||||
|
true
|
||||||
|
(let* [metadata (meta obj)
|
||||||
|
type (if (map? metadata) (get metadata :type))]
|
||||||
|
(cond
|
||||||
|
(keyword? type) type
|
||||||
|
(list? obj) :mal/list
|
||||||
|
(vector? obj) :mal/vector
|
||||||
|
(map? obj) :mal/map
|
||||||
|
(fn? obj) :mal/function
|
||||||
|
true (throw "unknown MAL value in protocols"))))))
|
||||||
|
|
||||||
|
;; A protocol (abstract class, interface..) is represented by a symbol.
|
||||||
|
;; It describes methods (abstract functions, contracts, signals..).
|
||||||
|
;; Each method is described by a sequence of two elements.
|
||||||
|
;; First, a symbol setting the name of the method.
|
||||||
|
;; Second, a vector setting its formal parameters.
|
||||||
|
;; The first parameter is required, plays a special role.
|
||||||
|
;; It is usually named `this` (`self`..).
|
||||||
|
;; For example,
|
||||||
|
;; (defprotocol protocol
|
||||||
|
;; (method1 [this])
|
||||||
|
;; (method2 [this argument]))
|
||||||
|
;; can be thought as:
|
||||||
|
;; (def! method1 (fn* [this]) ..)
|
||||||
|
;; (def! method2 (fn* [this argument]) ..)
|
||||||
|
;; (def! protocol ..)
|
||||||
|
;; The return value is the new protocol.
|
||||||
|
(defmacro! defprotocol (fn* [proto-name & methods]
|
||||||
|
;; A protocol is an atom mapping a type extending the protocol to
|
||||||
|
;; another map from method names as keywords to implementations.
|
||||||
|
(let* [
|
||||||
|
drop2 (fn* [args]
|
||||||
|
(if (= 2 (count args))
|
||||||
|
()
|
||||||
|
(cons (first args) (drop2 (rest args)))))
|
||||||
|
rewrite (fn* [method]
|
||||||
|
(let* [
|
||||||
|
name (first method)
|
||||||
|
args (nth method 1)
|
||||||
|
argc (count args)
|
||||||
|
varargs? (if (<= 2 argc) (= '& (nth args (- argc 2))))
|
||||||
|
dispatch `(get (get @~proto-name
|
||||||
|
(find-type ~(first args)))
|
||||||
|
~(keyword (str name)))
|
||||||
|
body (if varargs?
|
||||||
|
`(apply ~dispatch ~@(drop2 args) ~(nth args (- argc 1)))
|
||||||
|
(cons dispatch args))
|
||||||
|
]
|
||||||
|
(list 'def! name (list 'fn* args body))))
|
||||||
|
]
|
||||||
|
`(do
|
||||||
|
~@(map rewrite methods)
|
||||||
|
(def! ~proto-name (atom {}))))))
|
||||||
|
|
||||||
|
;; A type (concrete class..) extends (is a subclass of, implements..)
|
||||||
|
;; a protocol when it provides implementations for the required methods.
|
||||||
|
;; (extend type protocol {
|
||||||
|
;; :method1 (fn* [this] ..)
|
||||||
|
;; :method2 (fn* [this arg1 arg2])})
|
||||||
|
;; Additionnal protocol/methods pairs are equivalent to successive
|
||||||
|
;; calls with the same type.
|
||||||
|
;; The return value is `nil`.
|
||||||
|
(def! extend (fn* [type proto methods & more]
|
||||||
|
(do
|
||||||
|
(swap! proto assoc type methods)
|
||||||
|
(if (first more)
|
||||||
|
(apply extend type more)))))
|
||||||
|
|
||||||
|
;; An object satisfies a protocol when its type extends the protocol,
|
||||||
|
;; that is if the required methods can be applied to the object.
|
||||||
|
(def! satisfies? (fn* [protocol obj]
|
||||||
|
(contains? @protocol (find-type obj))))
|
||||||
|
;; If `(satisfies protocol obj)` with the protocol below
|
||||||
|
;; then `(method1 obj)` and `(method2 obj 1 2)`
|
||||||
|
;; dispatch to the concrete implementation provided by the exact type.
|
||||||
|
;; Should the type evolve, the calling code needs not change.
|
||||||
|
|
||||||
|
nil
|
33
lib/reducers.mal
Normal file
33
lib/reducers.mal
Normal file
@ -0,0 +1,33 @@
|
|||||||
|
;; 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
|
||||||
|
|
||||||
|
(let* [
|
||||||
|
rec (fn* [f xs acc index]
|
||||||
|
(if (< index 0)
|
||||||
|
acc
|
||||||
|
(rec f xs (f (nth xs index) acc) (- index 1))))
|
||||||
|
]
|
||||||
|
|
||||||
|
(fn* [f init xs]
|
||||||
|
;; f : Element Accumulator -> Accumulator
|
||||||
|
;; init : Accumulator
|
||||||
|
;; xs : sequence of Elements x1 x2 .. xn
|
||||||
|
;; return : Accumulator
|
||||||
|
(rec f xs init (- (count xs) 1)))))
|
||||||
|
|
||||||
|
nil
|
50
lib/test_cascade.mal
Normal file
50
lib/test_cascade.mal
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
;; 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
|
||||||
|
(cond (empty? xs) true
|
||||||
|
(pred (first xs)) (every? pred (rest xs))
|
||||||
|
true 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
|
||||||
|
(or (pred (first xs))
|
||||||
|
(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.
|
||||||
|
(cond (empty? xs) true
|
||||||
|
(= 1 (count xs)) (first xs)
|
||||||
|
true (let* (condvar (gensym))
|
||||||
|
`(let* (~condvar ~(first xs))
|
||||||
|
(if ~condvar (and ~@(rest xs)) ~condvar))))))
|
||||||
|
|
||||||
|
nil
|
35
lib/threading.mal
Normal file
35
lib/threading.mal
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
;; Composition of partially applied functions.
|
||||||
|
|
||||||
|
(load-file "../lib/reducers.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)
|
||||||
|
(reduce _iter-> x xs)))
|
||||||
|
|
||||||
|
(def! _iter->
|
||||||
|
(fn* [acc form]
|
||||||
|
(if (list? form)
|
||||||
|
`(~(first form) ~acc ~@(rest form))
|
||||||
|
(list form acc))))
|
||||||
|
|
||||||
|
;; 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)
|
||||||
|
(reduce _iter->> x xs)))
|
||||||
|
|
||||||
|
(def! _iter->>
|
||||||
|
(fn* [acc form]
|
||||||
|
(if (list? form)
|
||||||
|
`(~(first form) ~@(rest form) ~acc)
|
||||||
|
(list form acc))))
|
||||||
|
|
||||||
|
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
|
27
perf.mal
27
perf.mal
@ -1,27 +0,0 @@
|
|||||||
(defmacro! time
|
|
||||||
(fn* (exp)
|
|
||||||
`(let* (start_FIXME (time-ms)
|
|
||||||
ret_FIXME ~exp)
|
|
||||||
(do
|
|
||||||
(prn (str "Elapsed time: " (- (time-ms) start_FIXME) " msecs"))
|
|
||||||
ret_FIXME))))
|
|
||||||
|
|
||||||
(def! run-fn-for*
|
|
||||||
(fn* [fn max-ms acc-ms last-iters]
|
|
||||||
(let* [start (time-ms)
|
|
||||||
_ (fn)
|
|
||||||
elapsed (- (time-ms) start)
|
|
||||||
iters (+ 1 last-iters)
|
|
||||||
new-acc-ms (+ acc-ms elapsed)]
|
|
||||||
;(do (prn "new-acc-ms:" new-acc-ms "iters:" iters))
|
|
||||||
(if (>= new-acc-ms max-ms)
|
|
||||||
last-iters
|
|
||||||
(run-fn-for* fn max-ms new-acc-ms iters)))))
|
|
||||||
|
|
||||||
(def! run-fn-for
|
|
||||||
(fn* [fn max-secs]
|
|
||||||
(do
|
|
||||||
;; Warm it up first
|
|
||||||
(run-fn-for* fn 1000 0 0)
|
|
||||||
;; Now do the test
|
|
||||||
(run-fn-for* fn (* 1000 max-secs) 0 0))))
|
|
19
tests/computations.mal
Normal file
19
tests/computations.mal
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
;; Some inefficient arithmetic computations for benchmarking.
|
||||||
|
|
||||||
|
;; Unfortunately not yet available in tests of steps 4 and 5.
|
||||||
|
|
||||||
|
;; Compute n(n+1)/2 with a non tail-recursive call.
|
||||||
|
(def! sumdown
|
||||||
|
(fn* [n] ; non-negative number
|
||||||
|
(if (= n 0)
|
||||||
|
0
|
||||||
|
(+ n (sumdown (- n 1))))))
|
||||||
|
|
||||||
|
;; Compute a Fibonacci number with two recursions.
|
||||||
|
(def! fib
|
||||||
|
(fn* [n] ; non-negative number
|
||||||
|
(if (<= n 1)
|
||||||
|
n
|
||||||
|
(+ (fib (- n 1)) (fib (- n 2))))))
|
||||||
|
|
||||||
|
nil
|
61
tests/lib/equality.mal
Normal file
61
tests/lib/equality.mal
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
(def! orig= =)
|
||||||
|
|
||||||
|
;; Testing equality.mal does not fix built-in equality.
|
||||||
|
(load-file "../lib/equality.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
;; Testing and2
|
||||||
|
(and2)
|
||||||
|
;=>true
|
||||||
|
(and2 true)
|
||||||
|
;=>true
|
||||||
|
(and2 false)
|
||||||
|
;=>false
|
||||||
|
(and2 nil)
|
||||||
|
;=>false
|
||||||
|
(and2 1)
|
||||||
|
;=>true
|
||||||
|
(and2 1 2)
|
||||||
|
;=>true
|
||||||
|
(and2 nil (nth () 1))
|
||||||
|
;=>false
|
||||||
|
|
||||||
|
;; Testing or2
|
||||||
|
(or2)
|
||||||
|
;=>false
|
||||||
|
(or2 true)
|
||||||
|
;=>true
|
||||||
|
(or2 false)
|
||||||
|
;=>false
|
||||||
|
(or2 nil)
|
||||||
|
;=>false
|
||||||
|
(or2 1)
|
||||||
|
;=>true
|
||||||
|
(or2 1 (nth () 1))
|
||||||
|
;=>true
|
||||||
|
(or2 1 2)
|
||||||
|
;=>true
|
||||||
|
(or2 false nil)
|
||||||
|
;=>false
|
||||||
|
|
||||||
|
;; Breaking equality.
|
||||||
|
(def! = (fn* [a b] (and2 (orig= a b) (cond (list? a) (list? b) (vector? a) (vector? b) true true))))
|
||||||
|
(= [] ())
|
||||||
|
;=>false
|
||||||
|
|
||||||
|
;; Testing that equality.mal detects the problem.
|
||||||
|
(load-file "../lib/equality.mal")
|
||||||
|
;/equality.mal: Replaced = with pure mal implementation
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
;; Testing fixed equality.
|
||||||
|
(= [] ())
|
||||||
|
;=>true
|
||||||
|
(= [:a :b] (list :a :b))
|
||||||
|
;=>true
|
||||||
|
(= [:a :b] [:a :b :c])
|
||||||
|
;=>false
|
||||||
|
(= {:a 1} {:a 1})
|
||||||
|
;=>true
|
||||||
|
(= {:a 1} {:a 1 :b 2})
|
||||||
|
;=>false
|
18
tests/lib/memoize.mal
Normal file
18
tests/lib/memoize.mal
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
(load-file "../tests/computations.mal")
|
||||||
|
;=>nil
|
||||||
|
(load-file "../lib/memoize.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
(def! N 32)
|
||||||
|
|
||||||
|
;; Benchmark naive 'fib'
|
||||||
|
|
||||||
|
(def! r1 (fib N)) ; Should be slow
|
||||||
|
|
||||||
|
;; Benchmark memoized 'fib'
|
||||||
|
|
||||||
|
(def! fib (memoize fib))
|
||||||
|
(def! r2 (fib N)) ; Should be quick
|
||||||
|
|
||||||
|
(= r1 r2)
|
||||||
|
;=>true
|
38
tests/lib/pprint.mal
Normal file
38
tests/lib/pprint.mal
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
(load-file "../lib/pprint.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
(pprint '(7 8 9 "ten" [11 12 [13 14]] 15 16))
|
||||||
|
;/\(7
|
||||||
|
;/ 8
|
||||||
|
;/ 9
|
||||||
|
;/ "ten"
|
||||||
|
;/ \[11
|
||||||
|
;/ 12
|
||||||
|
;/ \[13
|
||||||
|
;/ 14\]\]
|
||||||
|
;/ 15
|
||||||
|
;/ 16\)
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
(pprint '{:abc 123 :def {:ghi 456 :jkl [789 "ten eleven twelve"]}})
|
||||||
|
;/\{:abc 123
|
||||||
|
;/ :def \{:ghi 456
|
||||||
|
;/ :jkl \[789
|
||||||
|
;/ "ten eleven twelve"\]\}\}
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
(pprint '(7 8 {:abc 123 :def {:ghi 456 :jkl 789}} 9 10 [11 12 [13 14]] 15 16))
|
||||||
|
;/\(7
|
||||||
|
;/ 8
|
||||||
|
;/ \{:abc 123
|
||||||
|
;/ :def \{:ghi 456
|
||||||
|
;/ :jkl 789\}\}
|
||||||
|
;/ 9
|
||||||
|
;/ 10
|
||||||
|
;/ \[11
|
||||||
|
;/ 12
|
||||||
|
;/ \[13
|
||||||
|
;/ 14\]\]
|
||||||
|
;/ 15
|
||||||
|
;/ 16\)
|
||||||
|
;=>nil
|
80
tests/lib/protocols.mal
Normal file
80
tests/lib/protocols.mal
Normal file
@ -0,0 +1,80 @@
|
|||||||
|
(load-file "../lib/protocols.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
;; Testing find-type for normal objects.
|
||||||
|
(find-type 'a)
|
||||||
|
;=>:mal/symbol
|
||||||
|
(find-type :a)
|
||||||
|
;=>:mal/keyword
|
||||||
|
(find-type (atom 0))
|
||||||
|
;=>:mal/atom
|
||||||
|
(find-type nil)
|
||||||
|
;=>:mal/nil
|
||||||
|
(find-type true)
|
||||||
|
;=>:mal/boolean
|
||||||
|
(find-type false)
|
||||||
|
;=>:mal/boolean
|
||||||
|
(find-type 0)
|
||||||
|
;=>:mal/number
|
||||||
|
(find-type "")
|
||||||
|
;=>:mal/string
|
||||||
|
(find-type (defmacro! m (fn* [] nil)))
|
||||||
|
;=>:mal/macro
|
||||||
|
(find-type ())
|
||||||
|
;=>:mal/list
|
||||||
|
(find-type [])
|
||||||
|
;=>:mal/vector
|
||||||
|
(find-type {})
|
||||||
|
;=>:mal/map
|
||||||
|
(find-type (fn* [] nil))
|
||||||
|
;=>:mal/function
|
||||||
|
|
||||||
|
;; Testing find-type for explicit type metadata.
|
||||||
|
(find-type ^{:type :a } ())
|
||||||
|
;=>:a
|
||||||
|
(find-type ^{:type :a } [])
|
||||||
|
;=>:a
|
||||||
|
(find-type ^{:type :a } {})
|
||||||
|
;=>:a
|
||||||
|
(find-type ^{:type :a } (fn* [] nil))
|
||||||
|
;=>:a
|
||||||
|
|
||||||
|
;; Testing protocols.
|
||||||
|
(def! o1 ^{:type :t1 } [1])
|
||||||
|
(def! o2 ^{:type :t2 } [2])
|
||||||
|
(defprotocol p1 [m0 [this]] [ma [this a]] [mb [this & b]])
|
||||||
|
(defprotocol p2)
|
||||||
|
(satisfies? p1 o1)
|
||||||
|
;=>false
|
||||||
|
(satisfies? p1 o2)
|
||||||
|
;=>false
|
||||||
|
(satisfies? p2 o1)
|
||||||
|
;=>false
|
||||||
|
(satisfies? p2 o2)
|
||||||
|
;=>false
|
||||||
|
(extend :t1 p1 { :m0 (fn* [this] (str "t0" this)) :ma (fn* [this a] (str "ta" this a)) :mb (fn* [this & b] (str "tb" this b))})
|
||||||
|
;=>nil
|
||||||
|
(extend :t2 p1 { :m0 (fn* [this] (str "u0" this)) :ma (fn* [this a] (str "ua" this a)) :mb (fn* [this & b] (str "ub" this b))} p2 {})
|
||||||
|
;=>nil
|
||||||
|
(satisfies? p1 o1)
|
||||||
|
;=>true
|
||||||
|
(satisfies? p1 o2)
|
||||||
|
;=>true
|
||||||
|
(satisfies? p2 o1)
|
||||||
|
;=>false
|
||||||
|
(satisfies? p2 o2)
|
||||||
|
;=>true
|
||||||
|
|
||||||
|
;; Testing dispatching.
|
||||||
|
(m0 o1)
|
||||||
|
;=>"t0[1]"
|
||||||
|
(ma o1 "blue")
|
||||||
|
;=>"ta[1]blue"
|
||||||
|
(mb o1 1 2 3)
|
||||||
|
;=>"tb[1](1 2 3)"
|
||||||
|
(m0 o2)
|
||||||
|
;=>"u0[2]"
|
||||||
|
(ma o2 "blue")
|
||||||
|
;=>"ua[2]blue"
|
||||||
|
(mb o2 1 2 3)
|
||||||
|
;=>"ub[2](1 2 3)"
|
32
tests/lib/reducers.mal
Normal file
32
tests/lib/reducers.mal
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
(load-file "../lib/reducers.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
;; Testing reduce
|
||||||
|
(reduce + 7 [])
|
||||||
|
;=>7
|
||||||
|
(reduce + 7 [1])
|
||||||
|
;=>8
|
||||||
|
(reduce + 7 [1 2])
|
||||||
|
;=>10
|
||||||
|
(reduce * 7 [-1 2])
|
||||||
|
;=>-14
|
||||||
|
(reduce concat [1] [[2] [3]])
|
||||||
|
;=>(1 2 3)
|
||||||
|
(reduce str "a" ["b" "c"])
|
||||||
|
;=>"abc"
|
||||||
|
|
||||||
|
;; Testing foldr
|
||||||
|
(foldr + 7 [])
|
||||||
|
;=>7
|
||||||
|
(foldr + 7 [1])
|
||||||
|
;=>8
|
||||||
|
(foldr + 7 [1 2])
|
||||||
|
;=>10
|
||||||
|
(reduce * 7 [-1 2])
|
||||||
|
;=>-14
|
||||||
|
(foldr concat [1] [[2] [3]])
|
||||||
|
;=>(2 3 1)
|
||||||
|
(foldr str "a" ["b" "c"])
|
||||||
|
;=>"bca"
|
||||||
|
(foldr cons [4 5] [2 3])
|
||||||
|
;=>(2 3 4 5)
|
27
tests/lib/test_cascade.mal
Normal file
27
tests/lib/test_cascade.mal
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
(load-file "../lib/test_cascade.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
;; Testing every?
|
||||||
|
(every? first [])
|
||||||
|
;=>true
|
||||||
|
(every? first [[1] [2]])
|
||||||
|
;=>true
|
||||||
|
(every? first [[1] [nil] []])
|
||||||
|
;=>false
|
||||||
|
|
||||||
|
;; Testing some
|
||||||
|
(some first [])
|
||||||
|
;=>nil
|
||||||
|
(some first [[nil] [1] []])
|
||||||
|
;=>1
|
||||||
|
|
||||||
|
(and)
|
||||||
|
;=>true
|
||||||
|
(and 1)
|
||||||
|
;=>1
|
||||||
|
(and 1 2 3 4)
|
||||||
|
;=>4
|
||||||
|
(and false 2)
|
||||||
|
;=>false
|
||||||
|
(and true 1 nil false)
|
||||||
|
;=>nil
|
22
tests/lib/threading.mal
Normal file
22
tests/lib/threading.mal
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
(load-file "../lib/threading.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
;; Testing -> macro
|
||||||
|
(-> 7)
|
||||||
|
;=>7
|
||||||
|
(-> (list 7 8 9) first)
|
||||||
|
;=>7
|
||||||
|
(-> (list 7 8 9) (first))
|
||||||
|
;=>7
|
||||||
|
(-> (list 7 8 9) first (+ 7))
|
||||||
|
;=>14
|
||||||
|
(-> (list 7 8 9) rest (rest) first (+ 7))
|
||||||
|
;=>16
|
||||||
|
|
||||||
|
;; Testing ->> macro
|
||||||
|
(->> "L")
|
||||||
|
;=>"L"
|
||||||
|
(->> "L" (str "A") (str "M"))
|
||||||
|
;=>"MAL"
|
||||||
|
(->> [4] (concat [3]) (concat [2]) rest (concat [1]))
|
||||||
|
;=>(1 3 4)
|
11
tests/lib/trivial.mal
Normal file
11
tests/lib/trivial.mal
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
(load-file "../lib/trivial.mal")
|
||||||
|
;=>nil
|
||||||
|
|
||||||
|
(dec 12)
|
||||||
|
;=>11
|
||||||
|
(zero? 12)
|
||||||
|
;=>false
|
||||||
|
(zero? 0)
|
||||||
|
;=>true
|
||||||
|
(identity 12)
|
||||||
|
;=>12
|
@ -1,5 +1,6 @@
|
|||||||
(load-file "../core.mal")
|
(load-file "../lib/threading.mal") ; ->
|
||||||
(load-file "../perf.mal")
|
(load-file "../lib/perf.mal") ; time
|
||||||
|
(load-file "../lib/test_cascade.mal") ; or
|
||||||
|
|
||||||
;;(prn "Start: basic macros performance test")
|
;;(prn "Start: basic macros performance test")
|
||||||
|
|
||||||
|
@ -1,11 +1,8 @@
|
|||||||
(load-file "../core.mal")
|
(load-file "../tests/computations.mal") ; fib sumdown
|
||||||
(load-file "../perf.mal")
|
(load-file "../lib/perf.mal") ; time
|
||||||
|
|
||||||
;;(prn "Start: basic math/recursion test")
|
;;(prn "Start: basic math/recursion test")
|
||||||
|
|
||||||
(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0)))
|
|
||||||
(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2)))))))
|
|
||||||
|
|
||||||
(time (do
|
(time (do
|
||||||
(sumdown 10)
|
(sumdown 10)
|
||||||
(fib 12)))
|
(fib 12)))
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
(load-file "../core.mal")
|
(load-file "../lib/threading.mal") ; ->
|
||||||
(load-file "../perf.mal")
|
(load-file "../lib/perf.mal") ; run-fn-for
|
||||||
|
(load-file "../lib/test_cascade.mal") ; or
|
||||||
|
|
||||||
;;(prn "Start: basic macros/atom test")
|
;;(prn "Start: basic macros/atom test")
|
||||||
|
|
||||||
|
@ -148,27 +148,3 @@ x
|
|||||||
|
|
||||||
(let* [x (or nil "yes")] x)
|
(let* [x (or nil "yes")] x)
|
||||||
;=>"yes"
|
;=>"yes"
|
||||||
|
|
||||||
;;
|
|
||||||
;; Loading core.mal
|
|
||||||
(load-file "../core.mal")
|
|
||||||
|
|
||||||
;; Testing -> macro
|
|
||||||
(-> 7)
|
|
||||||
;=>7
|
|
||||||
(-> (list 7 8 9) first)
|
|
||||||
;=>7
|
|
||||||
(-> (list 7 8 9) (first))
|
|
||||||
;=>7
|
|
||||||
(-> (list 7 8 9) first (+ 7))
|
|
||||||
;=>14
|
|
||||||
(-> (list 7 8 9) rest (rest) first (+ 7))
|
|
||||||
;=>16
|
|
||||||
|
|
||||||
;; Testing ->> macro
|
|
||||||
(->> "L")
|
|
||||||
;=>"L"
|
|
||||||
(->> "L" (str "A") (str "M"))
|
|
||||||
;=>"MAL"
|
|
||||||
(->> [4] (concat [3]) (concat [2]) rest (concat [1]))
|
|
||||||
;=>(1 3 4)
|
|
||||||
|
@ -286,12 +286,15 @@
|
|||||||
(let* [or_FIXME 23] (or false (+ or_FIXME 100)))
|
(let* [or_FIXME 23] (or false (+ or_FIXME 100)))
|
||||||
;=>123
|
;=>123
|
||||||
|
|
||||||
|
;; Loading sumdown from computations.mal
|
||||||
|
(load-file "../tests/computations.mal")
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Testing time-ms function
|
;; Testing time-ms function
|
||||||
(def! start-time (time-ms))
|
(def! start-time (time-ms))
|
||||||
(= start-time 0)
|
(= start-time 0)
|
||||||
;=>false
|
;=>false
|
||||||
(let* [sumdown (fn* (N) (if (> N 0) (+ N (sumdown (- N 1))) 0))] (sumdown 10)) ; Waste some time
|
(sumdown 10) ; Waste some time
|
||||||
;=>55
|
;=>55
|
||||||
(> (time-ms) start-time)
|
(> (time-ms) start-time)
|
||||||
;=>true
|
;=>true
|
||||||
|
Loading…
Reference in New Issue
Block a user