ludus/src/base.janet

# 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]
  (when (= :^nil value) (break :nil))
  (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)) ", ")
    :box (stringify (value :^value))
    :fn (string "fn " (value :name))
    :function (string "builtin " (string value))
    :pkg (dict-str value)
  ))

(set stringify stringify*)

(var show nil)

(defn- show-pkg [x]
  (def tab (struct/to-table x))
  (set (tab :^name) nil)
  (set (tab :^type) nil)
  (string "pkg " (x :^name) " {" (stringify tab) "}")
)

(defn- dict-show [dict]
  (string/join 
    (map 
      (fn [[k v]] (string (show k) " " (show v))) 
      (pairs dict))
    ", "))

(defn- set-show [sett]
  (def prepped (merge sett))
  (set (prepped :^type) nil)
  (def shown (map show (keys prepped)))
  (string/join shown ", ")
)

(defn- show* [x]
  (case (ludus/type x)
    :nil "nil"
    :string (string "\"" x "\"")
    :tuple (string "(" (string/join (map show x) ", ") ")")
    :list (string "[" (string/join (map show x) ", ") "]")
    :dict (string "#{" (dict-show x) "}")
    :set (string "${" (set-show x) "}")
    :box (string "box " (x :name) " [ " (show (x :^value)) " ]")
    :pkg (show-pkg x)
    (stringify x)))

(set show show*)

# (var json nil)

# (defn- dict-json [dict]
#   (string/join 
#     (map 
#       (fn [[k v]] (string (json k) ": " (json v))) 
#       (pairs dict))
#     ", "))

# (defn- json* [x]
#   (case (ludus/type x)
#     :nil "\"null\""
#     :number (string x)
#     :bool (if true "\"true\"" "\"false\"")
#     :string (string "\"" x "\"")
#     :keyword (string "\"" x "\"")
#     :tuple (string "[" (string/join (map json x) ", ") "]")
#     :list (string "["  (string/join (map json x) ", ")"]")
#     :dict (string "{" (dict-json x) "}")
#     :set (string "["  (string/join (map json (keys x)) ", ") "]")
#     (show x)))

# (set json json*)

(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])
    :splat (string "..." (when (x :splatted) (show-patt (x :splatted))))
    (error (string "cannot show pattern of unknown type " (x :type)))))

(defn pretty-patterns [fnn]
  (def {:body clauses} fnn)
  (string/join (map (fn [x] (-> x first show-patt)) clauses) "\n"))

(defn doc [fnn]
  (when (not= :fn (ludus/type fnn)) (break "No documentation available."))
  (def {:name name :doc docstring} fnn)
  (string/join [name 
                (pretty-patterns fnn) 
                (if docstring docstring "No docstring available.")] 
    "\n"))

(defn- conj!-set [sett value]
  (set (sett value) true)
  sett)

(defn- conj-set [sett value]
  (def new (merge sett))
  (conj!-set new value))

(defn- conj!-list [list value]
  (array/push list value))

(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)))

(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)

(defn disj [sett value]
  (def new (merge sett))
  (set (new value) nil)
  new)

(defn assoc! [dict key value]
  (set (dict key) value)
  dict)

(defn assoc [dict key value]
  (merge dict {key value}))

(defn dissoc! [dict key]
  (set (dict key) nil)
  dict)

(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 showprint [x]
  (if (= :string (ludus/type x))
    x
    (show x)))

(defn print! [args]
  (print ;(map showprint args)))

(defn prn [x]
  (pp x)
  x)

(defn concat [x y & zs]
  (case (ludus/type x)
    :string (string x y ;zs)
    :list (array/concat @[] x y ;zs)
    :set (merge x y ;zs)))

(defn unbox [b] (get b :^value))

(defn store! [b x] (set (b :^value) x))

(defn mod [x y] 
  (% x y))

(def ctx {
  "add" +
  "and" ludus/and
  "assoc!" assoc!
  "assoc" assoc
  "atan_2" math/atan2
  "bool" bool
  "ceil" math/ceil
  "concat" concat
  "conj!" conj!
  "conj" conj
  "cos" math/cos
  "count" length
  "dec" dec
  "disj!" disj!
  "disj" disj
  "dissoc!" dissoc!
  "dissoc" dissoc
  "div" /
  "doc" doc
  "downcase" string/ascii-lower
  "eq?" deep=
  "first" first
  "floor" math/floor
  "get" ludus/get
  "gt" >
  "gte" >=
  "inc" inc
  "last" last
  "lt" <
  "lte" <=
  "mod" mod
  "mult" *
  "not" not
  "nth" ludus/get
  "or" ludus/or
  "pi" math/pi
  "print!" print!
  "prn" prn
  "push" array/push
  "random" math/random
  "range" range
  "rest" rest
  "round" math/round
  "show" show
  "sin" math/sin
  "slice" array/slice
  "split" string/split
  "sqrt" math/sqrt
  "store!" store!
  "str_slice" string/slice
  "stringify" stringify
  "sub" -
  "tan" math/tan
  "to_list" to_list
  "trim" string/trim
  "triml" string/triml
  "trimr" string/trimr
  "type" ludus/type
  "unbox" unbox
  "upcase" string/ascii-upper
})

(def base (let [b @{}]
  (each [k v] (pairs ctx)
    (set (b (keyword k)) v))
  b))

(set (base :^type) :dict)