# 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- 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 "${" (string/join (map show (keys x)) ", ") "}") :box (string "box " (x :name) " [ " (show x) " ]") :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] (def {:name name :doc doc} fnn) (string/join [name (pretty-patterns fnn) doc] "\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" 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)