ludus/janet/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]
  (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))
    :applied (string "fn " (value :name))
    :function (string "builtin " (string value))
    :pkg (dict-str value)
  ))

(set stringify stringify*)

(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 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) " ]")
    :pkg (show-pkg x)
    (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]
  (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 print! [& args]
  (print ;(map show 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 [x] (get x :^value))

(defn store! [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
  "conj!" conj!
  "disj" disj
  "disj!" disj!
  "push" array/push
  "assoc" assoc
  "assoc!" assoc!
  "dissoc" dissoc
  "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
  "unbox" unbox
  "store!" store!
})

(def base (let [b @{}]
  (each [k v] (pairs ctx)
    (set (b (keyword k)) v))
  (table/to-struct b)))