210 lines
4.4 KiB
Plaintext
210 lines
4.4 KiB
Plaintext
# A base library for Ludus
|
|
# Only loaded in the prelude
|
|
|
|
(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
|
|
))
|
|
|
|
(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- 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])
|
|
(error (string "cannot show pattern of unknown type " (x :type)))))
|
|
|
|
(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))
|
|
|
|
(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 print! [& args]
|
|
(print ;(map show args)))
|
|
|
|
(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 x :value))
|
|
|
|
(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
|
|
"doc!" doc!
|
|
"concat" concat
|
|
"conj" conj
|
|
"disj" disj
|
|
"push" array/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
|
|
to_dict
|
|
)
|
|
|