(__ns__ pixie.stdlib)

(def reset! -reset!)

(def map (fn map [f]

(fn [xf]

(fn

([] (xf))

([result] (xf result))

([result item] (xf result (f item)))))))

(def conj (fn conj

([] [])

([result] result)

([result item] (-conj result item))))

(def conj! (fn conj!

([] (-transient []))

([result] (-persistent! result))

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

(def transduce (fn transduce

([f coll]

(let [result (-reduce coll f (f))]

(f result)))

([xform rf coll]

(let [f (xform rf)

result (-reduce coll f (f))]

(f result)))

([xform rf init coll]

(let [f (xform rf)

result (-reduce coll f init)]

(f result)))))

(def reduce (fn [rf init col]

(-reduce col rf init)))

(def interpose

(fn interpose [val]

(fn [xf]

(let [first? (atom true)]

(fn

([] (xf))

([result] (xf result))

([result item] (if @first?

(do (reset! first? false)

(xf result item))

(xf (xf result val) item))))))))

(def preserving-reduced

(fn [rf]

(fn [a b]

(let [ret (rf a b)]

(if (reduced? ret)

(reduced ret)

ret)))))

(def cat

(fn cat [rf]

(let [rrf (preserving-reduced rf)]

(fn cat-inner

([] (rf))

([result] (rf result))

([result input]

(reduce rrf result input))))))

(def seq-reduce (fn seq-reduce

[coll f init]

(loop [init init

coll (seq coll)]

(if (reduced? init)

@init

(if (seq coll)

(recur (f init (first coll))

(seq (next coll)))

init)))))

(def indexed-reduce (fn indexed-reduce

[coll f init]

(let [max (count coll)]

(loop [init init

i 0]

(if (reduced? init)

@init

(if (-eq i max)

init

(recur (f init (nth coll i)) (+ i 1))))))))

(extend -reduce Cons seq-reduce)

(extend -reduce PersistentList seq-reduce)

(extend -reduce LazySeq seq-reduce)

(comment (extend -reduce Array indexed-reduce))

(extend -str Bool

(fn [x]

(if (identical? x true)

"true"

"false")))

(extend -str Nil (fn [x] "nil"))

(extend -reduce Nil (fn [self f init] init))

(extend -hash Nil (fn [self] 100000))

(extend -hash Integer hash-int)

(extend -eq Integer -num-eq)

(def ordered-hash-reducing-fn

(fn ordered-hash-reducing-fn

([] (new-hash-state))

([state] (finish-hash-state state))

([state itm] (update-hash-ordered! state itm))))

(def unordered-hash-reducing-fn

(fn unordered-hash-reducing-fn

([] (new-hash-state))

([state] (finish-hash-state state))

([state itm] (update-hash-unordered! state itm))))

(extend -str PersistentVector

(fn [v]

(apply str "[" (conj (transduce (interpose ", ") conj v) "]"))))

(extend -str Cons

(fn [v]

(apply str "(" (conj (transduce (interpose ", ") conj v) ")"))))

(extend -hash Cons

(fn [v]

(transduce ordered-hash-reducing-fn v)))

(extend -str PersistentList

(fn [v]

(apply str "(" (conj (transduce (interpose ", ") conj v) ")"))))

(extend -str LazySeq

(fn [v]

(apply str "(" (conj (transduce (interpose ", ") conj v) ")"))))

(extend -hash PersistentVector

(fn [v]

(transduce ordered-hash-reducing-fn v)))

(def stacklet->lazy-seq

(fn [f]

(let [val (f nil)]

(if (identical? val :end)

nil

(cons val (lazy-seq* (fn [] (stacklet->lazy-seq f))))))))

(def sequence

(fn

([data]

(let [f (create-stacklet

(fn [h]

(reduce (fn ([h item] (h item) h)) h data)

(h :end)))]

(stacklet->lazy-seq f)))

([xform data]

(let [f (create-stacklet

(fn [h]

(transduce xform

(fn ([] h)

([h item] (h item) h)

([h] (h :end)))

data)))]

(stacklet->lazy-seq f)))))

(extend -seq PersistentVector sequence)

(extend -seq Array sequence)

(def concat (fn [& args] (transduce cat conj args)))

(def defn (fn [nm & rest] `(def ~nm (fn ~nm ~@rest))))

(set-macro! defn)

(defn defmacro [nm & rest]

`(do (defn ~nm ~@rest)

(set-macro! ~nm)

~nm))

(set-macro! defmacro)

(defn +

[& args]

(reduce -add 0 args))

(defn -

([] 0)

([x] (-sub 0 x))

([x & args]

(reduce -sub x args)))

(defn =

([x] true)

([x y] (eq x y))

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

(apply = y rest)

false)))

(def inc (fn [x] (+ x 1)))

(def dec (fn [x] (- x 1)))

(defn assoc

([m] m)

([m k v]

(-assoc m k v))

([m k v & rest]

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

(def slot-tp (create-type :slot [:val]))

(defn ->Slot [x]

(let [inst (new slot-tp)]

(set-field! inst :val x)))

(defn get-val [inst]

(get-field inst :val))

(defn comp

([f] f)

([f1 f2]

(fn [& args]

(f1 (apply f2 args))))

([f1 f2 f3]

(fn [& args]

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

(defn not [x]

(if x false true))

(defmacro cond

([] nil)

([test then & clauses]

`(if ~test

~then

(cond ~@clauses))))

(defmacro try [& body]

(loop [catch nil

catch-sym nil

body-items []

finally nil

body (seq body)]

(let [form (first body)]

(if form

(if (not (seq? form))

(recur catch catch-sym (conj body-items form) finally (next body))

(let [head (first form)]

(cond

(= head 'catch) (if catch

(throw "Can only have one catch clause per try")

(recur (next (next form)) (first (next form)) body-items finally (next body)))

(= head 'finally) (if finally

(throw "Can only have one finally clause per try")

(recur catch catch-sym body-items (next form) (next body)))

:else (recur catch catch-sym (conj body-items form) finally (next body)))))

`(-try-catch

(fn [] ~@body-items)

~(if catch

`(fn [~catch-sym] ~@catch)

`(fn [] nil))

(fn [] ~@finally))))))

(defn .

([obj sym]

(get-field obj sym))

([obj sym & args]

(apply (get-field obj sym) args)))

(extend -count MapEntry (fn [self] 2))

(extend -nth MapEntry (fn [self idx not-found]

(cond (= idx 0) (-key self)

(= idx 1) (-val self)

:else not-found)))

(defn key [x]

(-key x))

(defn val [x]

(-val x))

(extend -reduce MapEntry indexed-reduce)

(extend -str MapEntry

(fn [v]

(apply str "[" (conj (transduce (interpose ", ") conj v) "]"))))

(extend -hash MapEntry

(fn [v]

(transduce ordered-hash-reducing-fn v)))

(extend -str PersistentHashMap

(fn [v]

(apply str "{" (conj (transduce (comp cat (interpose " ")) conj v) "}"))))

(extend -hash PersistentHashMap

(fn [v]

(transduce cat unordered-hash-reducing-fn v)))

(extend -str Keyword

(fn [k]

(if (namespace k)

(str ":" (namespace k) "/" (name k))

(str ":" (name k)))))

(defn get

([mp k]

(get mp k nil))

([mp k not-found]

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

(defmacro assert

([test]

`(if ~test

nil

(throw "Assert failed")))

([test msg]

`(if ~test

nil

(throw (str "Assert failed " ~msg)))))

(defmacro resolve [sym]

`(resolve-in (this-ns-name) ~sym))

(defmacro with-bindings [binds & body]

`(do (push-binding-frame!)

(reduce (fn [_ map-entry]

(set! (resolve (key map-entry)) (val map-entry)))

nil

(apply hashmap ~binds))

(let [ret (do ~@body)]

(pop-binding-frame!)

ret)))

(def foo 42)

(set-dynamic! (resolve 'pixie.stdlib/foo))

(defmacro require [ns kw as-nm]

(assert (= kw :as) "Require expects :as as the second argument")

`(do (load-file (quote ~ns))

(refer (this-ns-name) (the-ns (quote ~ns)) (quote ~as-nm))))

(defmacro ns [nm & body]

`(do (__ns__ ~nm)

~@body))

(defn symbol? [x]

(identical? Symbol (type x)))

(defmacro deftype [nm fields & body]

(let [ctor-name (symbol (str "->" (name nm)))

type-decl `(def ~nm (create-type ~(keyword (name nm)) ~fields))

field-syms (transduce (map (comp symbol name)) conj fields)

inst (gensym)

ctor `(defn ~ctor-name ~field-syms

(let [~inst (new ~nm)]

~@(transduce

(map (fn [field]

`(set-field! ~inst ~field ~(symbol (name field)))))

conj

fields)

~inst))

proto-bodies (transduce

(map (fn [body]

(cond

(symbol? body) `(satisfy ~body ~nm)

(seq? body) `(extend ~(first body) ~nm (fn ~@body))

:else (assert false "Unknown body element in deftype, expected symbol or seq"))))

conj

body)]

`(do ~type-decl

~ctor

~@proto-bodies)))

(def libc (ffi-library (str "libc" "." pixie.platform/so-ext)))

(def exit (ffi-fn libc "exit" [Integer] Integer))

(def puts (ffi-fn libc "puts" [String] Integer))

(def printf (ffi-fn libc "printf" [String] Integer))