janet/examples/utils.dst

(defn table? [x] (= (type x) :table ))
(defn struct? [x] (= (type x) :struct))
(defn array? [x] (= (type x) :array))
(defn tuple? [x] (= (type x) :tuple))


(defn- reverse-array
    "Reverses the order of the elements in a given array"
  [t]
  (var  n (dec  (length t))  )
  (var reversed [])
  (while (>= n 0)
    (array-push  reversed (get t n))
    (-- n))
   reversed)


(defn- reverse-tuple
   "Reverses the order of the elements of a given tuple"
  [t]
  (def max (length t))
  (var  n  0)
  (var reversed (tuple))
  (while (< n max )
    (:= reversed (tuple-prepend reversed (get t n)))
    (++ n))
   reversed)

'(arrays are more efficient so reverse-tuple will not be used)

(defn reverse
  "Reverses order of elements in a given array or tuple"
  [t]
  (def the-type (type t))
  (cond (= the-type :tuple) (->> t iter2array reverse-array (apply tuple) )
        (= the-type :array) (reverse-array t)))


(defmacro if-not
"Sorthand for (if (not ... "
  [condition exp-1 exp-2]
  (tuple 'if (tuple 'not condition)
         exp-1
         exp-2))

(defmacro when-not
"Sorthand for (when (not ... "
  [condition exp-1]
  (tuple 'when (tuple 'not condition) exp-1))


(defmacro if-let
"Takes the first one or two forms in a vector and if true binds
 all the forms with let and evaluates the first expression else
 evaluates the second"
  [bindings then else]
  (def head (ast-unwrap1 bindings))
  (tuple 'let head
         (tuple 'if (and (get head 1) (if (get head 2) (get head 3) true))
              then
              else)))


(defmacro when-let
"Takes the first one or two forms in vector and if true binds
 all the forms  with let and evaluates body"
  [bindings & body]
  (def head (ast-unwrap1 bindings))
  (tuple 'let head
      (tuple
        'when
        (and (get head 1) (if (get head 2) (get head 3) true))
        (apply tuple (array-concat ['do] (ast-unwrap1 body)))  )))


(defn- comp0
  "Compose two functions. Second function must accept only one argument)"
 [f g] (fn [x] (f (g x))))


(defn comp
"Takes multiple functions and returns a function that is the composition
 of those functions."
  [& functions]
 (def len  (length functions))
 (if (zero? len)
   nil
   (if (one? len)
     (do
       (def the-composition (get functions 0))
       (fn [& x]
         (apply the-composition x)))
    (do
      (def f (get functions 0))
      (def g (get  functions 1))
     (apply comp  (comp0 f g) (array-slice functions  2 -1))) )))


(defn zipcoll
"Creates an table or tuple from two arrays/tuples. Result is table if no
third argument is given"
  [coll-1 coll-2 the-type]
  (var zipping-table @{})
  (def {:more more1 :next next1} (iter coll-1))
  (def {:more more2 :next next2} (iter coll-2))
  (while (more1)
    (put  zipping-table (next1) (next2)))
  (if (= :struct the-type)
    (table-to-struct zipping-table )
    zipping-table))

(defn update
"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]
  (def old-value (get coll a-key) )
  (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
  "Merges mutliple tables/structs to one. If a key appears in more than one
   collection, then later values replace any previous ones.
   The type of the first collection determines the type of the resulting
   collection"
  [& colls]
  (var container @{})
  (def merger (create-merger container))
  (foreach colls merger)
  (if (table? (get colls 0)) container (table-to-struct container)))


(defn juxt
"Takes a set of functions and returns the juxtaposition of those functions"
  [& functions]
  (fn [& x]
    (iter2array (map (fn [f] (apply f x)) functions))))