2024-05-15 04:05:25 +00:00
|
|
|
# A base library for Ludus
|
|
|
|
# Only loaded in the prelude
|
|
|
|
|
2024-05-19 22:04:08 +00:00
|
|
|
(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))
|
2024-05-15 04:05:25 +00:00
|
|
|
(case type
|
|
|
|
:nil ""
|
|
|
|
:number (string value)
|
2024-05-19 22:04:08 +00:00
|
|
|
: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
|
|
|
|
))
|
|
|
|
|
|
|
|
(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)))))
|
2024-05-15 04:05:25 +00:00
|
|
|
|
2024-05-19 22:04:08 +00:00
|
|
|
(defn disj [sett value]
|
|
|
|
(def new (merge sett))
|
2024-05-19 22:13:08 +00:00
|
|
|
(set (new value) nil)
|
2024-05-19 22:04:08 +00:00
|
|
|
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)))
|
|
|
|
|
2024-05-19 22:13:08 +00:00
|
|
|
(defn deref [x] (get x :value))
|
2024-05-19 22:04:08 +00:00
|
|
|
|
|
|
|
(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
|
2024-05-19 22:13:08 +00:00
|
|
|
"push" array/push
|
2024-05-19 22:04:08 +00:00
|
|
|
"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!
|
2024-05-15 04:05:25 +00:00
|
|
|
})
|
|
|
|
|
2024-05-19 22:04:08 +00:00
|
|
|
(comment
|
|
|
|
Used in current prelude but not yet in base:
|
|
|
|
|
|
|
|
into/2
|
|
|
|
doc
|
|
|
|
to_dict
|
|
|
|
)
|
|
|
|
|