write most of a base

janet/base.janet

@@ -1,18 +1,181 @@
 # A base library for Ludus
 # 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
     :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 {
+(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
+)
+