;; This file is used to build what we need to even start running stdlib.pxi

;; Ordering of stuff will probably matter here

(defprotocol ISeq

(-first [this])

(-next [this]))

(defprotocol ISeqable

(-seq [this]))

(defprotocol ICounted

(-count [this]))

(defprotocol IIndexed

(-nth [this idx])

(-nth-not-found [this idx not-found]))

(defprotocol IPersistentCollection

(-conj [this x])

(-disj [this x]))

(defprotocol IEmpty

(-empty [this]))

(defprotocol IObject

(-hash [this])

(-eq [this other])

(-str [this sbf])

(-repr [this sbf]))

(defprotocol IReduce

(-reduce [this f init]))

(defprotocol IDeref

(-deref [this]))

(defprotocol IReset

(-reset! [this val]))

(defprotocol INamed

(-namespace [this])

(-name [this]))

(defprotocol IAssociative

(-assoc [this k v])

(-contains-key [this k])

(-dissoc [this k]))

(defprotocol ILookup

(-val-at [this]))

(defprotocol IMapEntry

(-key [this])

(-val [this]))

(defprotocol IStack

(-push [this v]))

(defprotocol IPop

(-pop [this]))

(defprotocol IFn

(-invoke [this args]))

(defprotocol IDoc

(-doc [this]))

(defprotocol IVector)

(defprotocol ISequential)

(defprotocol IMap)

(defprotocol IMeta

(-with-meta [this x])

(-meta [this]))

(defprotocol ITransientCollection

(-conj! [this x]))

(defprotocol IToTransient

(-transient [this x]))

(defprotocol ITransient

(-persistent! [this]))

(defprotocol ITransientStack

(-push! [this x])

(-pop! [this]))

(defprotocol IDisposable

(-dispose! [this]))

(defprotocol IMessageObject

(-get-field [this name])

(-invoke-method [this name args]))

(defprotocol IEffect

(-effect-val [this v])

(-effect-finally [this v]))

(defeffect EException

(-throw [this kw data ks]))

(deftype ExceptionHandler [catches finally-fn]

IEffect

(-effect-val [this v]

v)

(-effect-finally [this v]

(when finally-fn

(finally-fn))

v)

EException

(-throw [this kw data ks k]

(let [c (or (get catches kw)

(get catches :*))]

(println "Got Exception" kw c)

(if c

(c {:ex kw :data data :ks (conj ks k)})

(-throw nil kw data (cons k ks))))))

(defn throw

([[kw val]]

(throw kw val))

([kw val]

(-throw nil

kw

val

[])))

(defn -try [body catches finally]

(with-handler [ex (->ExceptionHandler catches finally)]

(body)))

(-run-external-extends)

(extend -get-field Object -internal-get-field)

(extend -hash Object -internal-identity-hash)

(extend -meta Object (fn [x] nil))

(extend-type Object

(-str [x sb]

(sb (-internal-to-str x)))

(-repr [x sb]

(sb (-internal-to-repr x)))

(-eq [this other]

false))

(extend-type String

IObject

(-str [this sb]

(sb this)))

;; Math wrappers

(extend -eq Number -num-eq)

(defn +

{:doc "Adds the arguments, returning 0 if no arguments"

:signatures [[& args]]

:added "0.1"}

([] 0)

([x] x)

([x y] (-add x y))

([x y & more]

(-apply + (+ x y) more)))

(defn -

([] 0)

([x] x)

([x y] (-sub x y))

([x y & more]

(-apply - (- x y) more)))

(defn *

([] 1)

([x] x)

([x y] (-mul x y))

([x y & args]

(reduce -mul (-mul x y) args)))

(defn /

([x] (-div 1 x))

([x y] (-div x y))

([x y & args]

(reduce -div (-div x y) args)))

(defn quot [num div]

(-quot num div))

(defn rem [num div]

(-rem num div))

(defn inc

([x] (+ x 1)))

(defn dec

([x] (- x 1)))

(defn <

([x y] (-lt x y))

([x y & more]

(-apply < (< x y) more)))

(defn >

([x y] (-gt x y))

([x y & more]

(-apply > (> x y) more)))

(defn <=

([x] true)

([x y] (-lte x y))

([x y & rest] (if (-lte x y)

(apply <= y rest)

false)))

(defn >=

([x] true)

([x y] (-gte x y))

([x y & rest] (if (-gte x y)

(apply >= y rest)

false)))

(defn =

{:doc "Returns true if all the arguments are equivalent. Otherwise, returns false. Uses

-eq to perform equality checks."

:signatures [[& args]]

:added "0.1"}

([x] true)

([x y] (if (identical? x y)

true

(-eq x y)))

([x y & rest] (if (eq x y)

(apply = y rest)

false)))

(defn pos?

{:doc "Returns true if x is greater than zero"

:signatures [[x]]

:added "0.1"}

[x]

(> x 0))

(defn neg?

{:doc "Returns true if x is less than zero"

:signatures [[x]]

:added "0.1"}

[x]

(< x 0))

(defn zero?

{:doc "Returns true if x is equal to zero"

:signatures [[x]]

:added "0.1"}

[x]

(= x 0))

(defn even?

{:doc "Returns true if n is even"

:signatures [[n]]

:added "0.1"}

[n]

(zero? (rem n 2)))

(defn odd?

{:doc "Returns true of n is odd"

:signatures [[n]]

:added "0.1"}

[n]

(= (rem n 2) 1))

;; Base functions

(defn hash

[this]

(-hash this))

(defn identity

^{:doc "The identity function. Returns its argument."

:added "0.1"}

([x & _] x))

(defn not

[x]

(if x false true))

(defn not=

([& args]

(not (-apply = args))))

(defn nil?

[x]

(identical? x nil))

(defn deref

[x]

(-deref x))

(defn conj

{:doc "Adds elements to the transient collection. Elements are added to the end except in the case of Cons lists"

:signatures [[] [coll] [coll item] [coll item & args]]

:added "0.1"}

([] [])

([coll] coll)

([coll itm] (-conj coll itm))

([coll item & more]

(-apply conj (conj x y) more)))

(defn conj!

{:doc "Adds elements to the transient collection. Elements are added to the end except in the case of Cons lists"

:signatures [[] [coll] [coll item] [coll item & args]]

:added "0.1"}

([] (-transient pixie.stdlib.persistent-vector/EMPTY))

([coll] (-persistent! coll))

([coll item] (-conj! coll item))

([coll item & args]

(reduce -conj! (-conj! coll item) args)))

(defn disj

{:doc "Removes elements from the collection."

:signatures [[] [coll] [coll item]]

:added "0.1"}

([] [])

([coll] coll)

([coll item] (-disj coll item))

([coll item & items]

(reduce -disj (-disj coll item) items)))

(defn pop

{:doc "Pops elements off a stack."

:signatures [[] [coll] [coll item] [coll item & args]]

:added "0.1"}

([] [])

([coll] (-pop coll)))

(defn push

{:doc "Push an element on to a stack."

:signatures [[] [coll] [coll item] [coll item & args]]

:added "0.1"}

([coll x] (-push coll x)))

(defn pop!

{:doc "Pops elements off a transient stack."

:signatures [[] [coll] [coll item] [coll item & args]]

:added "0.1"}

([coll] (-pop! coll)))

(defn push!

{:doc "Push an element on to a transient stack."

:signatures [[] [coll] [coll item] [coll item & args]]

:added "0.1"}

([coll x] (-push! coll x)))

(defn nth

{:doc "Returns the element at the idx. If the index is not found it will return an error.

However, if you specify a not-found parameter, it will substitute that instead"

:signatures [[coll idx] [coll idx not-found]]

:added "0.1"}

([coll idx] (-nth coll idx))

([coll idx not-found] (-nth-not-found coll idx not-found)))

(defn get

{:doc "Get an element from a collection implementing ILookup, return nil or the default value if not found."

:added "0.1"}

([mp k]

(get mp k nil))

([mp k not-found]

(-val-at mp k not-found)))

(defn get-in

{:doc "Get a value from a nested collection at the \"path\" given by the keys."

:examples [["(get-in {:a [{:b 42}]} [:a 0 :b])" nil 42]]

:signatures [[m ks] [m ks not-found]]

:added "0.1"}

([m ks]

(reduce get m ks))

([m ks not-found]

(loop [sentinel 'x

m m

ks (seq ks)]

(if ks

(let [m (get m (first ks) sentinel)]

(if (identical? sentinel m)

not-found

(recur sentinel m (next ks))))

m))))

(defn contains?

[mp k]

(-contains-key mp k))

(defn name

[x] (-name x))

(defn namespace

[x] (-namespace x))

(defn dispose!

"Finalizes use of the object by cleaning up resources used by the object"

[x]

(-dispose! x)

nil)

(defn has-meta?

[x]

(satisfies? IMeta x))

(defn meta

[x]

(-meta x))

(defn with-meta

[x m]

(-with-meta x m))

(defn count

([coll]

(if (counted? coll)

(-count coll)

(loop [s (seq coll)

i 0]

(if (counted? s)

(+ i (count s))

(recur (next s)

(inc i)))))))

(defn assoc

{:doc "Associates the key with the value in the collection"

:signatures [[m] [m k v] [m k v & kvs]]

:added "0.1"}

([m] m)

([m k v]

(-assoc m k v))

([m k v & rest]

(apply assoc (-assoc m k v) rest)))

(defn merge

([a] a)

([a b]

(reduce

(fn [a [k v]]

(assoc a k v))

a

b))

([a b & cs]

(apply merge (merge a b) cs)))

(defn assoc-in

{:doc "Associate a value in a nested collection given by the path.

Creates new maps if the keys are not present."

:examples [["(assoc-in {} [:a :b :c] 42)" nil {:a {:b {:c 42}}}]]

:added "0.1"}

([m ks v]

(let [ks (seq ks)

k (first ks)

ks (next ks)]

(if ks

(assoc m k (assoc-in (get m k) ks v))

(assoc m k v)))))

(defn update-in

{:doc "Update a value in a nested collection."

:examples [["(update-in {:a {:b {:c 41}}} [:a :b :c] inc)" nil {:a {:b {:c 42}}}]]

:added "0.1"}

[m ks f & args]

(let [f (fn [m] (apply f m args))

update-inner-f (fn update-inner-f

([m f k]

(assoc m k (f (get m k))))

([m f k & ks]

(assoc m k (apply update-inner-f (get m k) f ks))))]

(apply update-inner-f m f ks)))

(defn key [m]

(-key m))

(defn val [m]

(-val m))

(defn keys

{:doc "If called with no arguments returns a transducer that will extract the key from each map entry. If passed

a collection, will assume that it is a hashmap and return a vector of all keys from the collection."

:signatures [[] [coll]]

:added "0.1"}

([] (map key))

([m]

(with-handler [g (->Generator)]

(transduce (map key) yield g m))))

(defn vals

{:doc "If called with no arguments returns a transducer that will extract the key from each map entry. If passed

a collection, will assume that it is a hashmap and return a vector of all keys from the collection."

:signatures [[] [coll]]

:added "0.1"}

([] (map val))

([m]

(with-handler [g (->Generator)]

(transduce (map val) yield g m))))

(defn seq [x]

(-seq x))

(defn first [x]

(if (satisfies? ISeq x)

(-first x)

(let [x (seq x)]

(if (nil? x)

nil

(-first x)))))

(defn second

{:doc "Returns the second item in coll, if coll implements IIndexed nth will be used to retrieve

the item from the collection."

:signatures [[coll]]

:added "0.1"}

[coll]

(if (satisfies? IIndexed coll)

(nth coll 1 nil)

(first (next coll))))

(defn third

{:doc "Returns the third item in coll, if coll implements IIndexed nth will be used to retrieve

the item from the collection."

:signatures [[coll]]

:added "0.1"}

[coll]

(if (satisfies? IIndexed coll)

(nth coll 2 nil)

(first (next (next coll)))))

(defn fourth

{:doc "Returns the fourth item in coll, if coll implements IIndexed nth will be used to retrieve

the item from the collection."

:signatures [[coll]]

:added "0.1"}

[coll]

(if (satisfies? IIndexed coll)

(nth coll 3 nil)

(first (next (next (next coll))))))

(defn next [x]

(if (satisfies? ISeq x)

(seq (-next x))

(let [x (seq x)]

(if (nil? x)

nil

(seq (-next x))))))

(defn nthnext

{:doc "Returns the result of calling next n times on the collection."

:examples [["(nthnext [1 2 3 4 5] 2)" nil (3 4 5)]

["(nthnext [1 2 3 4 5] 7)" nil nil]]

:added "0.1"}

[coll n]

(loop [n n

xs (seq coll)]

(if (and xs (pos? n))

(recur (dec n) (next xs))

xs)))

(defn apply [f & args]

(let [last-itm (last args)

but-last-cnt (dec (count args))

arg-array (make-array (+ but-last-cnt

(count last-itm)))

idx (reduce

(fn [idx itm]

(aset arg-array idx itm)

(inc idx))

but-last-cnt

last-itm)]

(array-copy args 0 arg-array 0 but-last-cnt)

(-apply f arg-array)))

(defn fnil [f else]

(fn [x & args]

(apply f (if (nil? x) else x) args)))

(defn comp

{:doc "Composes the given functions, applying the last function first."

:examples [["((comp inc first) [41 2 3])" nil 42]]

:signatures [[f] [f & fs]]

:added "0.1"}

([] identity)

([f] f)

([f1 f2]

(fn [& args]

(f1 (apply f2 args))))

([f1 f2 f3]

(fn [& args]

(f1 (f2 (apply f3 args)))))

([f1 f2 f3 & fs]

(fn [& args]

(apply (transduce comp (apply list f1 f2 f3 fs)) args))))

(defn last [coll]

(if (vector? coll)

(nth coll (dec (count coll)))

(loop [coll coll]

(if-let [v (next coll)]

(recur v)

(first coll)))))

(defn butlast [coll]

(loop [res []

coll coll]

(if (next coll)

(recur (conj res (first coll))

(next coll))

(seq res))))

(defn ith

{:doc "Returns the ith element of the collection, negative values count from the end.

If an index is out of bounds, will throw an Index out of Range exception.

However, if you specify a not-found parameter, it will substitute that instead"

:signatures [[coll i] [coll idx not-found]]

:added "0.1"}

([coll i]

(when coll

(let [idx (if (neg? i) (+ i (count coll)) i)]

(nth coll idx))))

([coll i not-found]

(when coll

(let [idx (if (neg? i) (+ i (count coll)) i)]

(nth coll idx not-found)))))

(defn take

{:doc "Takes n elements from the collection, or fewer, if not enough."

:added "0.1"}

[n coll]

(when (pos? n)

(when-let [s (seq coll)]

(cons (first s) (take (dec n) (next s))))))

(defn drop

{:doc "Drops n elements from the start of the collection."

:added "0.1"}

[n coll]

(let [s (seq coll)]

(if (and (pos? n) s)

(recur (dec n) (next s))

s)))

(defn repeat

([x]

(cons x (lazy-seq (repeat x))))

([n x]

(take n (repeat x))))

(defn take-while

{:doc "Returns a lazy sequence of successive items from coll while

(pred item) returns true. pred must be free of side-effects.

Returns a transducer when no collection is provided."

:added "0.1"}

([pred]

(fn [rf]

(fn

([] (rf))

([result] (rf result))

([result input]

(if (pred input)

(rf result input)

(reduced result))))))

([pred coll]

(lazy-seq

(when-let [s (seq coll)]

(when (pred (first s))

(cons (first s) (take-while pred (rest s))))))))

(defn drop-while

{:doc "Returns a lazy 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."

:added "0.1"}

([pred]

(fn [rf]

(let [dv (atom true)]

(fn

([] (rf))

([result] (rf result))

([result input]

(let [drop? @dv]

(if drop?

(if (pred input)

result

(do

(reset! dv nil)

(rf result input)))

(rf result input))))))))

([pred coll]

(let [step (fn [pred coll]

(let [s (seq coll)]

(if (and s (pred (first s)))

(recur pred (rest s))

s)))]

(lazy-seq (step pred coll)))))

;; TODO: use a transient map in the future

(defn group-by

{:doc "Groups the collection into a map keyed by the result of applying f on each element. The value at each key is a vector of elements in order of appearance."

:examples [["(group-by even? [1 2 3 4 5])" nil {false [1 3 5] true [2 4]}]

["(group-by (partial apply +) [[1 2 3] [2 4] [1 2]])" nil {6 [[1 2 3] [2 4]] 3 [[1 2]]}]]

:signatures [[f coll]]

:added "0.1"}

[f coll]

(reduce (fn [res elem]

(update-in res [(f elem)] (fnil conj []) elem))

{}

coll))

;; TODO: use a transient map in the future

(defn frequencies

{:doc "Returns a map with distinct elements as keys and the number of occurences as values"

:added "0.1"}

[coll]

(reduce (fn [res elem]

(update-in res [elem] (fnil inc 0)))

{}

coll))

(defn partition

{:doc "Separates the collection into collections of size n, starting at the beginning, with an optional step size.

The last element of the result contains the remaining element, not necessarily of size n if

not enough elements were present."

:examples [["(partition 2 [1 2 3 4 5 6])" nil ((1 2) (3 4) (5 6))]

["(partition 2 [1 2 3 4 5])" nil ((1 2) (3 4) (5))]

["(partition 2 1 [1 2 3 4 5])" nil ((1 2) (2 3) (3 4) (4 5) (5))]]

:signatures [[n coll] [n step coll]]

:added "0.1"}

([n coll] (partition n n coll))

([n step coll]

(when-let [s (seq coll)]

(cons (take n s) (lazy-seq (partition n step (drop step s)))))))

(defn partitionf

{:doc "A generalized version of partition. Instead of taking a constant number of elements,

this function calls f with the remaining collection to determine how many elements to

take."

:examples [["(partitionf first [2 :a, 3 :a :b, 4 :a :b :c])"

nil ((2 :a) (3 :a :b) (4 :a :b :c))]]}

[f coll]

(when-let [s (seq coll)]

(lazy-seq

(let [n (f s)]

(cons (take n s)

(partitionf f (drop n s)))))))

(defn seq-reduce [s f acc]

(let [s (seq s)]

(if (reduced? acc)

@acc

(if (nil? s)

acc

(seq-reduce (next s)

f

(f acc (first s)))))))

;; Some logic functions

(defn complement

{:doc "Given a function, return a new function which takes the same arguments

but returns the opposite truth value"}

[f]

(assert (fn? f) "Complement must be passed a function")

(fn

([] (not (f)))

([x] (not (f x)))

([x y] (not (f x y)))

([x y & more] (not (apply f x y more)))))

;;

;; Cons and List

(deftype Cons [head tail meta]

IObject

(-str [this sb]

(sb "(")

(let [not-first (atom false)]

(reduce

(fn [_ x]

(if @not-first

(sb " ")

(reset! not-first true))

(-str x sb))

nil

this))

(sb ")"))

ISeq

(-first [this] head)

(-next [this] tail)

ISeqable

(-seq [this] this)

IMeta

(-meta [this] meta)

(-with-meta [this new-meta]

(->Cons head tail new-meta))

IReduce

(-reduce [this f init]

(seq-reduce this f init))

IIndexed

(-nth [self idx]

(loop [i idx

s (seq self)]

(if (or (= i 0)

(nil? s))

(if (nil? s)

(throw [:pixie.stdlib/OutOfRangeException "Index out of Range"])

(first s))

(recur (dec i)

(next s)))))

(-nth-not-found [self idx not-found]

(loop [i idx

s (seq self)]

(if (or (= i 0)

(nil? s))

(if (nil? s)

not-found

(first s))

(recur (dec i)

(next s))))))

(defn cons [head tail]

(assert (satisfies? ISeqable tail) (str "Can't seq " tail))

(->Cons head tail nil))

(deftype List [head tail cnt hash-val meta]

IObject

(-hash [this]

(if hash-val

hash-val

(let [val (reduce

pixie.stdlib.hashing/ordered-hashing-rf

this)]

(set-field! this :hash-val val)

val)))

(-str [this sb]

(sb "(")

(let [not-first (atom false)]

(reduce

(fn [_ x]

(if @not-first

(sb " ")

(reset! not-first true))

(-str x sb))

nil

this))

(sb ")"))

IIndexed

(-nth [self idx]

(loop [i idx

s (seq self)]

(if (or (= i 0)

(nil? s))

(if (nil? s)

(first s)

(throw [:pixie.stdlib/OutOfRangeException "Index out of Range"]))

(recur (dec i)

(next s)))))

(-nth-not-found [self idx not-found]

(loop [i idx

s (seq self)]

(if (or (= i 0)

(nil? s))

(if (nil? s)

not-found

(first s))

(recur (dec i)

(next s)))))

IReduce

(-reduce [this f init]

(seq-reduce this f init))

ISeq

(-first [this] head)

(-next [this] tail)

ICounted

(-count [this] cnt)

ISeqable

(-seq [this] this)

IMeta

(-meta [this] meta)

(-with-meta [this new-meta]

(->List head tail cnt hash-val new-meta))

IPersistentCollection

(-conj [this val]

(->List val this (inc cnt) nil nil)))

(defn list [& args]

(loop [acc nil

idx (dec (count args))

cnt 1]

(if (>= idx 0)

(recur (->List (nth args idx)

acc

cnt

nil

nil)

(dec idx)

(inc cnt))

acc)))

;; LazySeq start

(in-ns :pixie.stdlib.lazy-seq)

(deftype LazySeq [f s hash-val meta-data]

ISeqable

(-seq [this]

(sval this)

(when (.-s this)

(loop [ls (.-s this)]

(if (instance? LazySeq ls)

(recur (sval ls))

(do (set-field! this :s ls)

(seq (.-s this)))))))

ISeq

(-first [this]

(seq this)

(first (.-s this)))

(-next [this]

(seq this)

(next (.-s this)))

IReduce

(-reduce [this f init]

(seq-reduce this f init))

IMessageObject

(-get-field [this field]

(get-field this field)))

(defn sval [this]

(if (.-f this)

(do (set-field! this :s ((.-f this)))

(set-field! this :f nil)

(.-s this))

(.-s this)))

(in-ns :pixie.stdlib)

(defn lazy-seq* [f]

(pixie.stdlib.lazy-seq/->LazySeq f nil nil nil))

(defeffect EGenerator

(-yield [this val]))

(deftype Generator []

IEffect

(-effect-val [this val]

nil)

(-effect-finally [this val]

val)

EGenerator

(-yield [this val k]

(cons val (lazy-seq (k nil)))))

(defn yield

([g] nil)

([g i]

(-yield g i)

g))