# 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 "ref " (x :name) "{" (x :value) "}") :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] (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 )