mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-26 00:10:27 +00:00
Code Issues 1 Releases Wiki Activity

Add update merge juxt and zipcoll

Browse Source
This commit is contained in:
Heefoo 2018-03-21 14:05:41 +02:00
parent 65ad7c981a
commit 26c8f7a5cf
1 changed files with 32 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
examples/utils.dst
View File

@ -3,6 +3,7 @@
(defn array? [x] (= (type x) :array)) (defn array? [x] (= (type x) :array))
(defn tuple? [x] (= (type x) :tuple)) (defn tuple? [x] (= (type x) :tuple))
(defn- reverse-array (defn- reverse-array
"Reverses the order of the elements in a given array" "Reverses the order of the elements in a given array"
[t] [t]
@ -26,8 +27,9 @@
reversed) reversed)
'(arrays are more efficient so reverse-tuple will not be used) '(arrays are more efficient so reverse-tuple will not be used)
(defn reverse (defn reverse
"Reverses order of give array or tuple" "Reverses order of elements in a given array or tuple"
[t] [t]
(def the-type (type t)) (def the-type (type t))
(cond (= the-type :tuple) (->> t iter2array reverse-array (apply tuple) ) (cond (= the-type :tuple) (->> t iter2array reverse-array (apply tuple) )
@ -48,8 +50,8 @@
(defmacro if-let (defmacro if-let
"Takes the first one or two forms in vector and if true binds "Takes the first one or two forms in a vector and if true binds
all the forms with let and evaluates first expression else all the forms with let and evaluates the first expression else
evaluates the second" evaluates the second"
[bindings then else] [bindings then else]
(def head (ast-unwrap1 bindings)) (def head (ast-unwrap1 bindings))
@ -61,7 +63,7 @@
(defmacro when-let (defmacro when-let
"Takes the first one or two forms in vector and if true binds "Takes the first one or two forms in vector and if true binds
all the forms with let and evaluates body " all the forms with let and evaluates body"
[bindings & body] [bindings & body]
(def head (ast-unwrap1 bindings)) (def head (ast-unwrap1 bindings))
(tuple 'let head (tuple 'let head
@ -78,8 +80,7 @@
(defn comp (defn comp
"Takes multiple functions and returns a function that is the composition "Takes multiple functions and returns a function that is the composition
of those functions. Resulting function accepts a variable number of of those functions."
arguments"
[& functions] [& functions]
(def len (length functions)) (def len (length functions))
(if (zero? len) (if (zero? len)
@ -95,9 +96,9 @@
(apply comp (comp0 f g) (array-slice functions 2 -1))) ))) (apply comp (comp0 f g) (array-slice functions 2 -1))) )))
(defn zip-coll (defn zipcoll
"Creates an table of map from two arrays/tuple. Defaults to table when no thrid "Creates an table or tuple from two arrays/tuples. Result is table if no
argumet is given" third argument is given"
[coll-1 coll-2 the-type] [coll-1 coll-2 the-type]
(var zipping-table @{}) (var zipping-table @{})
(def {:more more1 :next next1} (iter coll-1)) (def {:more more1 :next next1} (iter coll-1))
@ -105,44 +106,39 @@
(while (more1) (while (more1)
(put zipping-table (next1) (next2))) (put zipping-table (next1) (next2)))
(if (= :struct the-type) (if (= :struct the-type)
(table-to-struct zippint-table ) (table-to-struct zipping-table )
zipping-table)) zipping-table))
(defn update (defn update
"Uses a function to change the value in a collection" "Accepts a key argument and passes its associated value to a function.
The key, then is associated to that value"
[coll a-key a-function & args] [coll a-key a-function & args]
(def old-value (get coll a-key) ) (def old-value (get coll a-key) )
(put coll a-key (apply a-function old-value args))) (put coll a-key (apply a-function old-value args)))
(defn- create-merger [container]
(fn [x]
(var key (next x nil))
(while (not= nil key)
(put container (macroexpand1 key) (macroexpand1 (get x key)))
(:= key (next x key)))))
(defn merge (defn merge
"Merges mutliple tables/structs to one. If a key appears in more than one "Merges mutliple tables/structs to one. If a key appears in more than one
collection, then subsequence values replace previous ones collection, then later values replace any previous ones.
The type of the first collection determines the type of the resulting The type of the first collection determines the type of the resulting
collection" collection"
[head & colls] [& colls]
(if (:= tmp head) (var container @{})
(tuple-prepend head colls)) (def merger (create-merger container))
(defn create-merger [container]
(fn [x]
(def {:more more :next next} (pairs x))
(var tmp (next))
(while (more)
(put container (get tmp 0) (get tmp 1)))
(:= tmp (next))))
(def is-table (table? head))
(def merger (create-merger (if is-table head
(do (var container @{}) container))))
(foreach colls merger) (foreach colls merger)
(if is-table head (table-to-struct container))) (if (table? (get colls 0)) container (table-to-struct container)))
(defn juxt (defn juxt
"Takes a set of functions and returns the juxtaposition of those functions" "Takes a set of functions and returns the juxtaposition of those functions"
[& functions] [& functions]
(fn [& x] (fn [& x]
(map (fn [f] (apply f x)) functions))) (iter2array (map (fn [f] (apply f x)) functions))))