conjure-js 0.0.1

package/src/clojure/core.clj

@@ -0,0 +1,620 @@
+(ns clojure.core)
+
+(defmacro defn [name & fdecl]
+  (let [doc       (if (string? (first fdecl)) (first fdecl) nil)
+        rest-decl (if doc (rest fdecl) fdecl)
+        arglists  (if (vector? (first rest-decl))
+                    (vector (first rest-decl))
+                    (reduce (fn [acc arity] (conj acc (first arity))) [] rest-decl))]
+    (if doc
+      `(def ~name (with-meta (fn ~@rest-decl) {:doc ~doc :arglists '~arglists}))
+      `(def ~name (with-meta (fn ~@rest-decl) {:arglists '~arglists})))))
+
+(defn next
+  "Returns a seq of the items after the first. Calls seq on its
+  argument.  If there are no more items, returns nil."
+  [coll]
+  (seq (rest coll)))
+
+(defn not
+  "Returns true if x is logical false, false otherwise."
+  [x] (if x false true))
+
+(defn second
+  "Same as (first (next x))"
+  [coll]
+  (first (next coll)))
+
+
+(defmacro when [condition & body]
+  `(if ~condition (do ~@body) nil))
+
+(defmacro when-not [condition & body]
+  `(if ~condition nil (do ~@body)))
+
+(defmacro if-let
+  ([bindings then] `(if-let ~bindings ~then nil))
+  ([bindings then else]
+   (let [form (first bindings)
+         tst  (second bindings)]
+     `(let [~form ~tst]
+        (if ~form ~then ~else)))))
+
+(defmacro when-let [bindings & body]
+  (let [form (first bindings)
+        tst  (second bindings)]
+    `(let [~form ~tst]
+       (when ~form ~@body))))
+
+(defmacro and [& forms]
+  (if (nil? forms)
+    true
+    (if (nil? (seq (rest forms)))
+      (first forms)
+      `(let [v# ~(first forms)]
+         (if v# (and ~@(rest forms)) v#)))))
+
+(defmacro or [& forms]
+  (if (nil? forms)
+    nil
+    (if (nil? (seq (rest forms)))
+      (first forms)
+      `(let [v# ~(first forms)]
+         (if v# v# (or ~@(rest forms)))))))
+
+(defmacro cond [& clauses]
+  (if (nil? clauses)
+    nil
+    `(if ~(first clauses)
+       ~(first (next clauses))
+       (cond ~@(rest (rest clauses))))))
+
+(defmacro -> [x & forms]
+  (if (nil? forms)
+    x
+    (let [form (first forms)
+          more (rest forms)
+          threaded (if (list? form)
+                     `(~(first form) ~x ~@(rest form))
+                     `(~form ~x))]
+      `(-> ~threaded ~@more))))
+
+(defmacro ->> [x & forms]
+  (if (nil? forms)
+    x
+    (let [form (first forms)
+          more (rest forms)
+          threaded (if (list? form)
+                     `(~(first form) ~@(rest form) ~x)
+                     `(~form ~x))]
+      `(->> ~threaded ~@more))))
+
+(defmacro comment
+  ; Ignores body, yields nil
+  [& body])
+
+(defn constantly
+  "Returns a function that takes any number of arguments and returns x."
+  [x] (fn [& _] x))
+
+(defn some?
+  "Returns true if x is not nil, false otherwise"
+  [x] (not (nil? x)))
+
+(defn any?
+  "Returns true for any given argument"
+  [_x] true)
+
+(defn complement
+  "Takes a fn f and returns a fn that takes the same arguments as f,
+  has the same effects, if any, and returns the opposite truth value."
+  [f]
+  (fn
+    ([] (not (f)))
+    ([x] (not (f x)))
+    ([x y] (not (f x y)))
+    ([x y & zs] (not (apply f x y zs)))))
+
+(defn juxt
+  "Takes a set of functions and returns a fn that is the juxtaposition
+  of those fns. The returned fn takes a variable number of args and
+  returns a vector containing the result of applying each fn to the args."
+  [& fns]
+  (fn [& args]
+    (reduce (fn [acc f] (conj acc (apply f args))) [] fns)))
+
+(defn merge
+  "Returns a map that consists of the rest of the maps conj-ed onto
+  the first. If a key occurs in more than one map, the mapping from
+  the latter (left-to-right) will be the mapping in the result."
+  [& maps]
+  (if (nil? maps)
+    nil
+    (reduce
+     (fn [acc m]
+       (if (nil? m)
+         acc
+         (if (nil? acc)
+           m
+           (reduce
+            (fn [macc entry]
+              (assoc macc (first entry) (second entry)))
+            acc
+            m))))
+     nil
+     maps)))
+
+(defn select-keys
+  "Returns a map containing only those entries in map whose key is in keys."
+  [m keys]
+  (if (or (nil? m) (nil? keys))
+    {}
+    (let [missing (gensym)]
+      (reduce
+       (fn [acc k]
+         (let [v (get m k missing)]
+           (if (= v missing)
+             acc
+             (assoc acc k v))))
+       {}
+       keys))))
+
+(defn update
+  "Updates a value in an associative structure where k is a key and f is a
+  function that will take the old value and any supplied args and return the
+  new value, and returns a new structure."
+  [m k f & args]
+  (let [target (if (nil? m) {} m)]
+    (assoc target k (if (nil? args)
+                      (f (get target k))
+                      (apply f (get target k) args)))))
+
+(defn get-in
+  "Returns the value in a nested associative structure, where ks is a
+  sequence of keys. Returns nil if the key is not present, or the not-found
+  value if supplied."
+  ([m ks]
+   (reduce get m ks))
+  ([m ks not-found]
+   (loop [m m, ks (seq ks)]
+     (if (nil? ks)
+       m
+       (if (contains? m (first ks))
+         (recur (get m (first ks)) (next ks))
+         not-found)))))
+
+(defn assoc-in
+  "Associates a value in a nested associative structure, where ks is a
+  sequence of keys and v is the new value. Returns a new nested structure."
+  [m [k & ks] v]
+  (if ks
+    (assoc m k (assoc-in (get m k) ks v))
+    (assoc m k v)))
+
+(defn update-in
+  "Updates a value in a nested associative structure, where ks is a
+  sequence of keys and f is a function that will take the old value and any
+  supplied args and return the new value. Returns a new nested structure."
+  [m ks f & args]
+  (assoc-in m ks (apply f (get-in m ks) args)))
+
+(defn fnil
+  "Takes a function f, and returns a function that calls f, replacing
+  a nil first argument with x, optionally nil second with y, nil third with z."
+  ([f x]
+   (fn [a & more]
+     (apply f (if (nil? a) x a) more)))
+  ([f x y]
+   (fn [a b & more]
+     (apply f (if (nil? a) x a) (if (nil? b) y b) more)))
+  ([f x y z]
+   (fn [a b c & more]
+     (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) more))))
+
+(defn frequencies
+  "Returns a map from distinct items in coll to the number of times they appear."
+  [coll]
+  (if (nil? coll)
+    {}
+    (reduce
+     (fn [counts item]
+       (assoc counts item (inc (get counts item 0))))
+     {}
+     coll)))
+
+(defn group-by
+  "Returns a map of the elements of coll keyed by the result of f on each
+  element. The value at each key is a vector of matching elements."
+  [f coll]
+  (if (nil? coll)
+    {}
+    (reduce
+     (fn [acc item]
+       (let [k (f item)]
+         (assoc acc k (conj (get acc k []) item))))
+     {}
+     coll)))
+
+(defn distinct
+  "Returns a vector of the elements of coll with duplicates removed,
+  preserving first-seen order."
+  [coll]
+  (if (nil? coll)
+    []
+    (get
+     (reduce
+      (fn [state item]
+        (let [seen (get state 0)
+              out  (get state 1)]
+          (if (get seen item false)
+            state
+            [(assoc seen item true) (conj out item)])))
+      [{} []]
+      coll)
+     1)))
+
+(defn flatten-step
+  "Internal helper for flatten."
+  [v]
+  (if (or (list? v) (vector? v))
+    (reduce
+     (fn [acc item]
+       (into acc (flatten-step item)))
+     []
+     v)
+    [v]))
+
+(defn flatten
+  "Takes any nested combination of sequential things (lists/vectors) and
+  returns their contents as a single flat vector."
+  [x]
+  (if (nil? x)
+    []
+    (flatten-step x)))
+
+(defn reduce-kv
+  "Reduces an associative structure. f should be a function of 3
+  arguments: accumulator, key/index, value."
+  [f init coll]
+  (cond
+    (map? coll)
+    (reduce
+     (fn [acc entry]
+       (f acc (first entry) (second entry)))
+     init
+     coll)
+
+    (vector? coll)
+    (loop [idx 0
+           acc init]
+      (if (< idx (count coll))
+        (recur (inc idx) (f acc idx (nth coll idx)))
+        acc))
+
+    :else
+    (throw
+     (ex-info
+      "reduce-kv expects a map or vector"
+      {:coll coll}))))
+
+(defn sort-compare
+  "Internal helper: normalizes comparator results."
+  [cmp a b]
+  (let [r (cmp a b)]
+    (if (number? r)
+      (< r 0)
+      r)))
+
+(defn insert-sorted
+  "Internal helper for insertion-sort based sort implementation."
+  [cmp x sorted]
+  (loop [left  []
+         right sorted]
+    (if (nil? (seq right))
+      (conj left x)
+      (let [y (first right)]
+        (if (sort-compare cmp x y)
+          (into (conj left x) right)
+          (recur (conj left y) (rest right)))))))
+
+(defn sort
+  "Returns the items in coll in sorted order. With no comparator, sorts
+  ascending using <. Comparator may return boolean or number."
+  ([coll] (sort < coll))
+  ([cmp coll]
+   (if (nil? coll)
+     []
+     (reduce
+      (fn [acc item]
+        (insert-sorted cmp item acc))
+      []
+      coll))))
+
+(defn sort-by
+  "Returns a sorted sequence of items in coll, where the sort order is
+  determined by comparing (keyfn item)."
+  ([keyfn coll] (sort-by keyfn < coll))
+  ([keyfn cmp coll]
+   (sort
+    (fn [a b]
+      (cmp (keyfn a) (keyfn b)))
+    coll)))
+
+(def not-any? (comp not some))
+
+(defn not-every?
+  "Returns false if (pred x) is logical true for every x in
+  coll, else true."
+  [pred coll] (not (every? pred coll)))
+
+;; ── Transducer protocol ──────────────────────────────────────────────────────
+
+;; into: 2-arity uses reduce+conj; 3-arity uses transduce
+(defn into
+  "Returns a new coll consisting of to-coll with all of the items of
+   from-coll conjoined. A transducer may be supplied."
+  ([to from] (reduce conj to from))
+  ([to xf from] (transduce xf conj to from)))
+
+;; sequence: materialise a transducer over a collection into a seq (list)
+(defn sequence
+  "Coerces coll to a (possibly empty) sequence, if it is not already
+  one. Will not force a seq. (sequence nil) yields (), When a
+  transducer is supplied, returns a lazy sequence of applications of
+  the transform to the items in coll"
+  ([coll] (apply list (into [] coll)))
+  ([xf coll] (apply list (into [] xf coll))))
+
+(defn completing
+  "Takes a reducing function f of 2 args and returns a fn suitable for
+  transduce by adding an arity-1 signature that calls cf (default -
+  identity) on the result argument."
+  ([f] (completing f identity))
+  ([f cf]
+   (fn
+     ([] (f))
+     ([x] (cf x))
+     ([x y] (f x y)))))
+
+;; map: 1-arg returns transducer; 2-arg is eager; 3+-arg zips collections
+(defn map
+  "Returns a sequence consisting of the result of applying f to the set
+  of first items of each coll, followed by applying f to the set of
+  second items in each coll, until any one of the colls is exhausted.
+  Any remaining items in other colls are ignored. Returns a transducer
+  when no collection is provided."
+  ([f]
+   (fn [rf]
+     (fn
+       ([] (rf))
+       ([result] (rf result))
+       ([result input] (rf result (f input))))))
+  ([f coll]
+   (sequence (map f) coll))
+  ([f c1 c2]
+   (loop [s1 (seq c1)
+          s2 (seq c2)
+          acc []]
+     (if (or (nil? s1) (nil? s2))
+       acc
+       (recur
+        (next s1)
+        (next s2)
+        (conj acc (f (first s1) (first s2)))))))
+  ([f c1 c2 & colls]
+   (loop [seqs (map seq (cons c1 (cons c2 colls)))
+          acc []]
+     (if (some nil? seqs)
+       acc
+       (recur (map next seqs) (conj acc (apply f (map first seqs))))))))
+
+;; filter: 1-arg returns transducer; 2-arg is eager
+(defn filter
+  "Returns a sequence of the items in coll for which
+  (pred item) returns logical true. pred must be free of side-effects.
+  Returns a transducer when no collection is provided."
+  ([pred]
+   (fn [rf]
+     (fn
+       ([] (rf))
+       ([result] (rf result))
+       ([result input]
+        (if (pred input)
+          (rf result input)
+          result)))))
+  ([pred coll]
+   (sequence (filter pred) coll)))
+
+(defn remove
+  "Returns a lazy sequence of the items in coll for which
+  (pred item) returns logical false. pred must be free of side-effects.
+  Returns a transducer when no collection is provided."
+  ([pred] (filter (complement pred)))
+  ([pred coll]
+   (filter (complement pred) coll)))
+
+
+
+;; take: stateful transducer; signals early termination after n items
+;; r > 0 → keep going; r = 0 → take last item and stop; r < 0 → already past limit, stop
+(defn take
+  "Returns a sequence of the first n items in coll, or all items if
+  there are fewer than n.  Returns a stateful transducer when
+  no collection is provided."
+  ([n]
+   (fn [rf]
+     (let [remaining (volatile! n)]
+       (fn
+         ([] (rf))
+         ([result] (rf result))
+         ([result input]
+          (let [n @remaining
+                nrem (vswap! remaining dec)
+                result (if (pos? n)
+                         (rf result input)
+                         result)]
+            (if (not (pos? nrem))
+              (ensure-reduced result)
+              result)))))))
+  ([n coll]
+   (sequence (take n) coll)))
+
+;; take-while: stateless transducer; emits reduced when pred fails
+(defn take-while
+  "Returns a sequence of successive items from coll while
+  (pred item) returns logical true. pred must be free of side-effects.
+  Returns a transducer when no collection is provided."
+  ([pred]
+   (fn [rf]
+     (fn
+       ([] (rf))
+       ([result] (rf result))
+       ([result input]
+        (if (pred input)
+          (rf result input)
+          (reduced result))))))
+  ([pred coll]
+   (sequence (take-while pred) coll)))
+
+;; drop: stateful transducer; skips first n items
+;; r >= 0 → still skipping; r < 0 → past the drop zone, start taking
+(defn drop
+  "Returns a sequence of all but the first n items in coll.
+   Returns a stateful transducer when no collection is provided."
+  ([n]
+   (fn [rf]
+     (let [remaining (volatile! n)]
+       (fn
+         ([] (rf))
+         ([result] (rf result))
+         ([result input]
+          (let [rem @remaining]
+            (vswap! remaining dec)
+            (if (pos? rem)
+              result
+              (rf result input))))))))
+  ([n coll]
+   (sequence (drop n) coll)))
+
+(defn drop-last
+  "Return a sequence of all but the last n (default 1) items in coll"
+  ([coll] (drop-last 1 coll))
+  ([n coll] (map (fn [x _] x) coll (drop n coll))))
+
+(defn take-last
+  "Returns a sequence of the last n items in coll.  Depending on the type
+  of coll may be no better than linear time.  For vectors, see also subvec."
+  [n coll]
+  (loop [s (seq coll), lead (seq (drop n coll))]
+    (if lead
+      (recur (next s) (next lead))
+      s)))
+
+;; drop-while: stateful transducer; passes through once pred fails
+(defn drop-while
+  "Returns a sequence of the items in coll starting from the
+  first item for which (pred item) returns logical false.  Returns a
+  stateful transducer when no collection is provided."
+  ([pred]
+   (fn [rf]
+     (let [dropping (volatile! true)]
+       (fn
+         ([] (rf))
+         ([result] (rf result))
+         ([result input]
+          (if (and @dropping (pred input))
+            result
+            (do
+              (vreset! dropping false)
+              (rf result input))))))))
+  ([pred coll]
+   (sequence (drop-while pred) coll)))
+
+;; map-indexed: stateful transducer; passes index and item to f
+(defn map-indexed
+  "Returns a sequence consisting of the result of applying f to 0
+   and the first item of coll, followed by applying f to 1 and the second
+   item in coll, etc, until coll is exhausted. Thus function f should
+   accept 2 arguments, index and item. Returns a stateful transducer when
+   no collection is provided."
+  ([f]
+   (fn [rf]
+     (let [i (volatile! -1)]
+       (fn
+         ([] (rf))
+         ([result] (rf result))
+         ([result input]
+          (rf result (f (vswap! i inc) input)))))))
+  ([f coll]
+   (sequence (map-indexed f) coll)))
+
+;; dedupe: stateful transducer; removes consecutive duplicates
+(defn dedupe
+  "Returns a sequence removing consecutive duplicates in coll.
+   Returns a transducer when no collection is provided."
+  ([]
+   (fn [rf]
+     (let [pv (volatile! ::none)]
+       (fn
+         ([] (rf))
+         ([result] (rf result))
+         ([result input]
+          (let [prior @pv]
+            (vreset! pv input)
+            (if (= prior input)
+              result
+              (rf result input))))))))
+  ([coll]
+   (sequence (dedupe) coll)))
+
+;; partition-all: stateful transducer; groups items into vectors of size n
+(defn partition-all
+  "Returns a sequence of lists like partition, but may include
+   partitions with fewer than n items at the end.  Returns a stateful
+   transducer when no collection is provided."
+  ([n]
+   (fn [rf]
+     (let [buf (volatile! [])]
+       (fn
+         ([] (rf))
+         ([result]
+          (let [b @buf]
+            (vreset! buf [])
+            (if (empty? b)
+              (rf result)
+              (rf (unreduced (rf result b))))))
+         ([result input]
+          (let [nb (conj @buf input)]
+            (if (= (count nb) n)
+              (do
+                (vreset! buf [])
+                (rf result nb))
+              (do
+                (vreset! buf nb)
+                result))))))))
+  ([n coll]
+   (sequence (partition-all n) coll)))
+
+;; ── Documentation ────────────────────────────────────────────────────────────
+
+(defmacro doc [sym]
+  `(let [v#        ~sym
+         m#        (meta v#)
+         d#        (:doc m#)
+         args#     (:arglists m#)
+         args-str# (when args#
+                     (reduce
+                      (fn [acc# a#]
+                        (if (= acc# "")
+                          (str "(" a# ")")
+                          (str acc# "\n" "(" a# ")")))
+                      ""
+                      args#))]
+     (println (str (if args-str# (str args-str# "\n\n") "")
+                   (or d# "No documentation available.")))))
+
+(defn err
+  "Creates an error map with type, message, data and optionally cause"
+  ([type message] (err type message nil nil))
+  ([type message data] (err type message data nil))
+  ([type message data cause] {:type type :message message :data data :cause cause}))