ludus/janet/base.janet

244 lines
5.2 KiB
Plaintext
Raw Normal View History

# 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))
(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))
:applied (string "fn " (value :name))
2024-05-19 22:04:08 +00:00
:function (string "builtin " (string value))
2024-06-04 18:50:48 +00:00
:pkg (dict-str value)
2024-05-19 22:04:08 +00:00
))
(set stringify stringify*)
2024-06-04 18:50:48 +00:00
(defn- show-pkg [x]
(def tab (struct/to-table x))
(set (tab :^name) nil)
(set (tab :^type) nil)
(string "pkg " (x :^name) " {" (stringify tab) "}")
)
2024-05-19 22:04:08 +00:00
(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 "box " (x :name) " [ " (stringify x) " ]")
2024-06-04 18:50:48 +00:00
:pkg (show-pkg x)
2024-05-19 22:04:08 +00:00
(stringify x)))
2024-06-04 17:00:34 +00:00
(defn- show-patt [x]
(case (x :type)
:nil "nil"
:bool (string (x :data))
:number (string (x :data))
:keyword (string ":" (x :data))
:word (x :data)
:placeholder (get-in x [:token :lexeme])
:tuple (string "(" (string/join (map show-patt (x :data)) ", ") ")")
:list (string "[" (string/join (map show-patt (x :data)) ", ")"]")
:dict (string "#{" (string/join (map show-patt (x :data)) ", ") "}")
:pair (string (show-patt (get-in x [:data 0])) " " (show-patt (get-in x [:data 1])))
:typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
:interpolated (get-in x [:token :lexeme])
:string (get-in x [:token :lexeme])
2024-06-04 17:02:15 +00:00
(error (string "cannot show pattern of unknown type " (x :type)))))
2024-06-04 17:00:34 +00:00
2024-06-04 17:28:20 +00:00
(defn doc! [fnn]
(def {:name name :doc doc :body clauses} fnn)
(print "doccing " name)
(def patterns (map (fn [x] (-> x first show-patt)) clauses))
(print name)
(print (string/join patterns " "))
(print doc))
2024-06-04 17:00:34 +00:00
(defn- conj!-set [sett value]
(set (sett value) true)
sett)
2024-05-19 22:04:08 +00:00
(defn- conj-set [sett value]
(def new (merge sett))
(conj!-set new value))
(defn- conj!-list [list value]
(array/push list value))
2024-05-19 22:04:08 +00:00
(defn- conj-list [list value]
(def new (array/slice list))
(conj!-list new value))
(defn conj! [x value]
(case (ludus/type x)
:list (conj!-list x value)
:set (conj!-set x value)))
2024-05-19 22:04:08 +00:00
(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]
(set (sett value) nil)
sett)
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]
(set (dict key) value)
dict)
2024-05-19 22:04:08 +00:00
(defn assoc [dict key value]
(merge dict {key value}))
(defn dissoc! [dict key]
(set (dict key) nil)
dict)
2024-05-19 22:04:08 +00:00
(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]))
2024-06-04 17:28:20 +00:00
(defn print! [& args]
(print ;(map show args)))
2024-05-19 22:04:08 +00:00
(defn prn [x]
(pp x)
x)
(defn concat [x y & zs]
2024-05-19 22:04:08 +00:00
(case (ludus/type x)
:string (string x y ;zs)
:list (array/concat @[] x y ;zs)
:set (merge x y ;zs)))
2024-05-19 22:04:08 +00:00
(defn unbox [x] (get x :^value))
2024-05-19 22:04:08 +00:00
(defn store! [x] (set (x :^value) x))
2024-05-19 22:04:08 +00:00
(def ctx {
2024-06-04 17:28:20 +00:00
"print!" print!
2024-05-19 22:04:08 +00:00
"prn" prn
2024-06-04 18:25:22 +00:00
"eq?" deep=
2024-05-19 22:04:08 +00:00
"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
2024-06-04 17:28:20 +00:00
"doc!" doc!
2024-05-19 22:04:08 +00:00
"concat" concat
"conj" conj
"conj!" conj!
2024-05-19 22:04:08 +00:00
"disj" disj
"disj!" disj!
2024-05-19 22:13:08 +00:00
"push" array/push
2024-05-19 22:04:08 +00:00
"assoc" assoc
"assoc!" assoc!
2024-05-19 22:04:08 +00:00
"dissoc" dissoc
"dissoc!" dissoc!
2024-05-19 22:04:08 +00:00
"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
"unbox" unbox
"store!" store!
})
2024-06-04 20:24:54 +00:00
(def base (let [b @{}]
(each [k v] (pairs ctx)
(set (b (keyword k)) v))
(table/to-struct b)))
2024-05-19 22:04:08 +00:00