write most of a base

This commit is contained in:
Scott Richmond 2024-05-19 18:04:08 -04:00
parent 24bbef74aa
commit e468add325

View File

@ -1,18 +1,181 @@
# A base library for Ludus # A base library for Ludus
# Only loaded in the prelude # Only loaded in the prelude
(defn- stringify [value] (defn bool [x] (if (= :^nil x) nil x))
(def typed? (when (table? value) (:^type value))
(def type (if typed? typed? (type value)) (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 (case type
:nil "" :nil ""
:number (string value) :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 { (set stringify stringify*)
:name "show"
:fn () (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
)