diff --git a/janet/base.janet b/janet/base.janet index 913125f..d0bd447 100644 --- a/janet/base.janet +++ b/janet/base.janet @@ -1,18 +1,181 @@ # A base library for Ludus # Only loaded in the prelude -(defn- stringify [value] - (def typed? (when (table? value) (:^type value)) - (def type (if typed? typed? (type value)) +(defn bool [x] (if (= :^nil x) nil x)) + +(defn ludus/and [& args] (every? (map bool args))) + +(defn ludus/or [& args] (some bool args)) + +(defn ludus/type [value] + (def typed? (when (dictionary? value) (value :^type))) + (def the-type (if typed? typed? (type value))) + (case the-type + :buffer :string + :boolean :bool + :array :list + :table :dict + :cfunction :function + the-type)) + +(var stringify nil) + +(defn- dict-str [dict] + (string/join + (map + (fn [[k v]] (string (stringify k) " " (stringify v))) + (pairs dict)) + ", ")) + +(defn- stringish? [x] (or (string? x) (buffer? x))) + +(defn- stringify* [value] + (when (stringish? value) (break value)) + (def type (ludus/type value)) (case type :nil "" :number (string value) - : - ) -) + :bool (string value) + :keyword (string ":" value) + :tuple + (string/join (map stringify value) ", ") + :list + (string/join (map stringify value) ", ") + :dict (dict-str value) + :set + (string/join (map stringify (keys value)) ", ") + :ref (stringify (value :^value)) + :fn (string "fn " (value :name)) + :function (string "builtin " (string value)) + # XXX: pkg, fn + )) -(def show { - :name "show" - :fn () +(set stringify stringify*) + +(defn show [x] + (case (ludus/type x) + :nil "nil" + :string (string "\"" x "\"") + :tuple (string "(" (stringify x) ")") + :list (string "[" (stringify x) "]") + :dict (string "#{" (stringify x) "}") + :set (string "${" (stringify x) "}") + :ref (string "ref:" (x :name) "{" (x :value) "}") + (stringify x))) + +(defn- conj-set [sett value] + (def new (merge sett)) + (set (new value) true) + new) + +(defn- conj-list [list value] + (def new (array/slice list)) + (array/push new value)) + +(defn conj [x value] + (case (ludus/type x) + :list (conj-list x value) + :set (conj-set x value) + (error (string "cannot conj onto " (show x))))) + +(defn disj [sett value] + (def new (merge sett)) + (set (new/value) nil) + new) + +(defn assoc [dict key value] + (merge dict {key value})) + +(defn dissoc [dict key] + (def new (merge dict)) + (set (new key) nil) + new) + +(defn ludus/get [key dict &opt def] + (default def :^nil) + (get dict key def)) + +(defn rest [indexed] + (array/slice indexed 1)) + +(defn to_list [x] + (case (ludus/type x) + :list x + :tuple @[;x] + :dict (pairs x) + :set (-> x (dissoc :^type) keys) + @[x])) + +(defn prn [x] + (pp x) + x) + +(defn concat [x y] + (case (ludus/type x) + :string (string x y) + :list (array/concat @[] x y) + :set (merge x y))) + +(defn deref [x] (get :value) x) + +(defn set! [x] (set (x :value) x)) + +(def ctx { + "print" print + "prn" prn + "eq" deep= + "bool" bool + "and" ludus/and + "or" ludus/or + "add" + + "sub" - + "mult" * + "div" / + "mod" % + "gt" > + "gte" >= + "lt" < + "lte" <= + "inc" inc + "dec" dec + "not" not + "type" ludus/type + "stringify" stringify + "show" show + "concat" concat + "conj" conj + "disj" disj + "push" push + "assoc" assoc + "dissoc" dissoc + "get" ludus/get + "nth" ludus/get + "first" first + "rest" rest + "last" last + "slice" slice + "to_list" to_list + "count" length + "pi" math/pi + "sin" math/sin + "cos" math/cos + "tan" math/tan + "atan_2" math/atan2 + "sqrt" math/sqrt + "random" math/random + "floor" math/floor + "ceil" math/ceil + "round" math/round + "range" range + "deref" deref + "set!" set! }) +(comment +Used in current prelude but not yet in base: + +into/2 +doc +to_dict +) +