diff options
| author | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
| commit | 8c5cca122817bc63f4f84cc8351ced3cb67e5eea (patch) | |
| tree | 8803dd3ed59ddcc6b964354fd312ab9e62e12cd8 | |
| parent | 1ef969c8ce0f1a83ffa8d26d779806190ac3eced (diff) | |
- Changed the identifier separator, from the semi-colon (;) to the period/dot (.).
189 files changed, 10064 insertions, 10057 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 949387954..4638cf5d9 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -214,7 +214,7 @@ Called by `imenu--generic-function'." (,(concat "(" (regexp-opt - '(";module:" + '(".module:" "def:" "type:" "macro:" "syntax:" "program:" "sig:" "struct:" "context:" "template:" "class:" "interface:" @@ -261,9 +261,9 @@ Called by `imenu--generic-function'." ; Deg literals ("\\<\\(\\.[0-9_]+\\)\\>" 0 font-lock-constant-face) ; Tags - ("#;[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>\.,/\\\\\\|':~\\?]+" 0 font-lock-type-face) - ("#;;[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>\.,/\\\\\\|':~\\?]+" 0 font-lock-type-face) - ("#[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>\.,/\\\\\\|':~\\?]+\\(;[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>\.,/\\\\\\|':~\\?]+\\)?" 0 font-lock-type-face) + ("#\\.[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>\.,/\\\\\\|':~\\?]+" 0 font-lock-type-face) + ("#\\.\\.[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>\.,/\\\\\\|':~\\?]+" 0 font-lock-type-face) + ("#[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>;,/\\\\\\|':~\\?]+\\(\\.[a-zA-Z0-9-\\+_=!@\\$%\\^&\\*<>;,/\\\\\\|':~\\?]+\\)?" 0 font-lock-type-face) )) "Default expressions to highlight in Lux mode.") @@ -342,7 +342,7 @@ This function also returns nil meaning don't specify the indentation." (method nil) (function-tail (first (last - (split-string (substring-no-properties function) ";"))))) + (split-string (substring-no-properties function) "\\."))))) (setq method (get (intern-soft function-tail) 'lux-indent-function)) (cond ((member (char-after open-paren) '(?\[ ?\{)) (goto-char open-paren) diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index c8a263030..090165af9 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -122,7 +122,7 @@ nil) _ - ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " module ";" name)) + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) state)))) (defn def-type @@ -133,7 +133,7 @@ (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] (|let [[?type ?meta ?value] $def] (return* state ?type)) - ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (str module ";" name))) + ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (str module &/+name-separator+ name))) state)) ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module)) state)))) @@ -156,7 +156,8 @@ ?value])) _ - ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name])))) + ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name])) + "\nMETA: " (&/show-ast ?meta))) state))) ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (&/ident->text (&/T [module name])))) state)) @@ -398,7 +399,7 @@ [_ ?def-meta _] _def-data] (|case (&meta/meta-get &meta/alias-tag ?def-meta) (&/$Some [_ (&/$Symbol [?r-module ?r-name])]) - (&/T [k (str ?r-module ";" ?r-name) _def-data]) + (&/T [k (str ?r-module &/+name-separator+ ?r-name) _def-data]) _ (&/T [k "" _def-data]) @@ -409,7 +410,7 @@ (|case (&meta/meta-get <tag> meta) (&/$Some [_ (&/$Bool true)]) (&/try-all% (&/|list (&type/check <type> type) - (&/fail-with-loc (str "[Analyser Error] Cannot tag as lux;" <desc> "? if it's not a " <desc> ": " (str module ";" name))))) + (&/fail-with-loc (str "[Analyser Error] Cannot tag as lux;" <desc> "? if it's not a " <desc> ": " (str module &/+name-separator+ name))))) _ (return nil))) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 910bdfadf..ae9b2bb47 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -219,7 +219,7 @@ ;; [Exports] (def ^:const value-field "_value") (def ^:const module-class-name "_") -(def ^:const +name-separator+ ";") +(def ^:const +name-separator+ ".") (def ^:const ^String version "0.6.0") @@ -1217,12 +1217,12 @@ [_ ($Tag ?module ?tag)] (if (.equals "" ?module) (str "#" ?tag) - (str "#" ?module ";" ?tag)) + (str "#" ?module +name-separator+ ?tag)) [_ ($Symbol ?module ?name)] (if (.equals "" ?module) ?name - (str ?module ";" ?name)) + (str ?module +name-separator+ ?name)) [_ ($Tuple ?elems)] (str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]") @@ -1245,7 +1245,7 @@ (|let [[?module ?name] ident] (if (= "" ?module) ?name - (str ?module ";" ?name)))) + (str ?module +name-separator+ ?name)))) (defn fold2% [f init xs ys] (|case [xs ys] diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index 4c3b1a436..678fda334 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -96,7 +96,7 @@ (let [parts (.split _def-entry &&core/datum-separator)] (case (alength parts) 2 (let [[_name _alias] parts - [_ __module __name] (re-find #"^(.*);(.*)$" _alias) + [_ __module __name] (re-find #"^(.*)\.(.*)$" _alias) def-anns (make-record (&/|list (&/T [(make-tag &a-meta/alias-tag) (make-symbol (&/T [__module __name]))])))] (|do [def-type (&a-module/def-type __module __name) diff --git a/luxc/src/lux/compiler/cache/ann.clj b/luxc/src/lux/compiler/cache/ann.clj index 4be70a611..3111886ba 100644 --- a/luxc/src/lux/compiler/cache/ann.clj +++ b/luxc/src/lux/compiler/cache/ann.clj @@ -8,7 +8,6 @@ (def ^:private stop (->> 7 char str)) (def ^:private cons-signal (->> 5 char str)) (def ^:private nil-signal (->> 6 char str)) -(def ^:private ident-separator ";") (defn ^:private serialize-seq [serialize params] (str (&/fold (fn [so-far param] @@ -19,7 +18,7 @@ (defn ^:private serialize-ident [ident] (|let [[module name] ident] - (str module ident-separator name))) + (str module &/+name-separator+ name))) (defn serialize "(-> Code Text)" @@ -89,7 +88,7 @@ (defn <name> [^String input] (when (.startsWith input <marker>) (let [[^String ident* ^String input*] (.split (.substring input 1) stop 2) - [_module _name] (.split ident* ident-separator 2)] + [_module _name] (.split ident* "\\." 2)] [(&/T [dummy-cursor (<tag> (&/T [_module _name]))]) input*]))) ^:private deserialize-symbol "@" &/$Symbol diff --git a/luxc/src/lux/compiler/cache/type.clj b/luxc/src/lux/compiler/cache/type.clj index 88e1d5a03..76cdbec52 100644 --- a/luxc/src/lux/compiler/cache/type.clj +++ b/luxc/src/lux/compiler/cache/type.clj @@ -9,7 +9,6 @@ (def ^:private stop (->> 7 char str)) (def ^:private cons-signal (->> 5 char str)) (def ^:private nil-signal (->> 6 char str)) -(def ^:private ident-separator ";") (defn ^:private serialize-list [serialize-type params] (str (&/fold (fn [so-far param] @@ -61,7 +60,7 @@ (str "%" (serialize-type left) (serialize-type right)) (&/$Named [module name] type*) - (str "@" module ident-separator name stop (serialize-type type*)) + (str "@" module &/+name-separator+ name stop (serialize-type type*)) _ (assert false (prn 'serialize-type (&type/show-type type))) @@ -118,7 +117,7 @@ (defn ^:private deserialize-named [^String input] (when (.startsWith input "@") (let [[^String module+name ^String input*] (.split (.substring input 1) stop 2) - [module name] (.split module+name ident-separator 2)] + [module name] (.split module+name "\\." 2)] (when-let [[type* ^String input*] (deserialize-type input*)] [(&/$Named (&/T [module name]) type*) input*])))) diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj index 6319f1b2b..ae3a6425c 100644 --- a/luxc/src/lux/compiler/js/lux.clj +++ b/luxc/src/lux/compiler/js/lux.clj @@ -324,7 +324,7 @@ _ (&/without-repl-closure (&a-module/define module-name ?name def-type def-meta def-value))] (return nil)) - (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " module-name ";" ?name))) + (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " (str module-name &/+name-separator+ ?name)))) (&/$Some _) (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an Ident.") @@ -371,7 +371,7 @@ [_ (&/$None)] (return nil)) - :let [_ (println 'DEF (str module-name ";" ?name))]] + :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] (return nil)) )) ) diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index b76a889b0..024abeb73 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -266,7 +266,7 @@ _ (&/without-repl-closure (&a-module/define module-name ?name def-type def-meta def-value))] (return nil)) - (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " module-name ";" ?name)))) + (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " (str module-name &/+name-separator+ ?name))))) (&/$Some _) (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be a symbol.") @@ -343,7 +343,7 @@ [_ (&/$None)] (return nil)) - :let [_ (println 'DEF (str module-name ";" ?name))]] + :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] (return nil))) _ @@ -412,7 +412,7 @@ [_ (&/$None)] (return nil)) - :let [_ (println 'DEF (str module-name ";" ?name))]] + :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] (return nil))) )))) diff --git a/luxc/src/lux/lexer.clj b/luxc/src/lux/lexer.clj index 65a99de6a..7bd329766 100644 --- a/luxc/src/lux/lexer.clj +++ b/luxc/src/lux/lexer.clj @@ -98,7 +98,7 @@ (return (&/T [meta ($Text token)])))) (def +ident-re+ - #"^([^0-9\[\]\{\}\(\)\s\"#;][^\[\]\{\}\(\)\s\"#;]*)") + #"^([^0-9\[\]\{\}\(\)\s\"#.][^\[\]\{\}\(\)\s\"#.]*)") ;; [Lexers] (def ^:private lex-white-space @@ -144,10 +144,12 @@ lex-frac $Frac #"^-?(0\.[0-9_]+|[1-9][0-9_]*\.[0-9_]+)(e-?[1-9][0-9_]*)?" ) +(def +same-module-mark+ (str &/+name-separator+ &/+name-separator+)) + (def ^:private lex-ident (&/try-all-% "[Reader Error]" (&/|list (|do [[meta _ token] (&reader/read-regex +ident-re+) - [_ _ got-it?] (&reader/read-text? ";")] + [_ _ got-it?] (&reader/read-text? &/+name-separator+)] (|case got-it? (&/$Some _) (|do [[_ _ local-token] (&reader/read-regex +ident-re+) @@ -159,11 +161,11 @@ (&/$None) (return (&/T [meta (&/T ["" token])])))) - (|do [[meta _ _] (&reader/read-text ";;") + (|do [[meta _ _] (&reader/read-text +same-module-mark+) [_ _ token] (&reader/read-regex +ident-re+) module-name &/get-module-name] (return (&/T [meta (&/T [module-name token])]))) - (|do [[meta _ _] (&reader/read-text ";") + (|do [[meta _ _] (&reader/read-text &/+name-separator+) [_ _ token] (&reader/read-regex +ident-re+)] (return (&/T [meta (&/T ["lux" token])]))) ))) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 0087a8d89..c1d94e53b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -13,9 +13,9 @@ ("lux def" List (+12 ["lux" "List"] (+9 (+0) - (+3 ## "lux;Nil" + (+3 ## "lux.Nil" (+2) - ## "lux;Cons" + ## "lux.Cons" (+4 (+6 +1) (+11 (+6 +1) (+6 +0)))))) [dummy-cursor @@ -151,9 +151,9 @@ ("lux def" Maybe (+12 ["lux" "Maybe"] (+9 #Nil - (+3 ## "lux;None" + (+3 ## "lux.None" (+2) - ## "lux;Some" + ## "lux.Some" (+6 +1)))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -193,31 +193,31 @@ {Type-Pair (+11 Void (+9 #Nil - (+3 ## "lux;Primitive" + (+3 ## "lux.Primitive" (+4 Text Type-List) - (+3 ## "lux;Void" + (+3 ## "lux.Void" (+2) - (+3 ## "lux;Unit" + (+3 ## "lux.Unit" (+2) - (+3 ## "lux;Sum" + (+3 ## "lux.Sum" Type-Pair - (+3 ## "lux;Product" + (+3 ## "lux.Product" Type-Pair - (+3 ## "lux;Function" + (+3 ## "lux.Function" Type-Pair - (+3 ## "lux;Bound" + (+3 ## "lux.Bound" Nat - (+3 ## "lux;Var" + (+3 ## "lux.Var" Nat - (+3 ## "lux;Ex" + (+3 ## "lux.Ex" Nat - (+3 ## "lux;UnivQ" + (+3 ## "lux.UnivQ" (+4 Type-List Type) - (+3 ## "lux;ExQ" + (+3 ## "lux.ExQ" (+4 Type-List Type) - (+3 ## "lux;App" + (+3 ## "lux.Apply" Type-Pair - ## "lux;Named" + ## "lux.Named" (+4 Ident Type)))))))))))))))})})})) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -315,7 +315,7 @@ (#Cons [[dummy-cursor (+7 ["lux" "doc"])] [dummy-cursor (+5 "The type of things that can be annotated with meta-data of arbitrary types.")]] (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "m")] (#Cons [dummy-cursor (+5 "v")] #;Nil)))]] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "m")] (#Cons [dummy-cursor (+5 "v")] #Nil)))]] (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "export?"])] @@ -343,27 +343,27 @@ ("lux case" ("lux check type" (#Apply Code List)) {Code-List (#UnivQ #Nil - (#Sum ## "lux;Bool" + (#Sum ## "lux.Bool" Bool - (#Sum ## "lux;Nat" + (#Sum ## "lux.Nat" Nat - (#Sum ## "lux;Int" + (#Sum ## "lux.Int" Int - (#Sum ## "lux;Deg" + (#Sum ## "lux.Deg" Deg - (#Sum ## "lux;Frac" + (#Sum ## "lux.Frac" Frac - (#Sum ## "lux;Text" + (#Sum ## "lux.Text" Text - (#Sum ## "lux;Symbol" + (#Sum ## "lux.Symbol" Ident - (#Sum ## "lux;Tag" + (#Sum ## "lux.Tag" Ident - (#Sum ## "lux;Form" + (#Sum ## "lux.Form" Code-List - (#Sum ## "lux;Tuple" + (#Sum ## "lux.Tuple" Code-List - ## "lux;Record" + ## "lux.Record" (#Apply (#Product Code Code) List) )))))))))) )})})) @@ -382,7 +382,7 @@ (#Cons [dummy-cursor (+5 "Record")] #Nil))))))))))))]] (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #;Nil))]] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #Nil))]] (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] (#Cons [[dummy-cursor (+7 ["lux" "export?"])] @@ -500,16 +500,16 @@ (#Named ["lux" "Bindings"] (#UnivQ #Nil (#UnivQ #Nil - (#Product ## "lux;counter" + (#Product ## "lux.counter" Nat - ## "lux;mappings" + ## "lux.mappings" (#Apply (#Product (#Bound +3) (#Bound +1)) List))))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "counter") (#Cons (text$ "mappings") #Nil)))] (#Cons [(tag$ ["lux" "type-args"]) - (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #;Nil)))] + (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #Nil)))] default-def-meta-exported)))) ## (type: #export Ref @@ -555,14 +555,14 @@ (#Named ["lux" "Either"] (#UnivQ #Nil (#UnivQ #Nil - (#Sum ## "lux;Left" + (#Sum ## "lux.Left" (#Bound +3) - ## "lux;Right" + ## "lux.Right" (#Bound +1))))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "Left") (#Cons (text$ "Right") #Nil)))] (#Cons [(tag$ ["lux" "type-args"]) - (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #;Nil)))] + (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #Nil)))] (#Cons [(tag$ ["lux" "doc"]) (text$ "A choice between two values of different types.")] default-def-meta-exported))))) @@ -603,28 +603,28 @@ ## #module-state Module-State}) ("lux def" Module (#Named ["lux" "Module"] - (#Product ## "lux;module-hash" + (#Product ## "lux.module-hash" Nat - (#Product ## "lux;module-aliases" + (#Product ## "lux.module-aliases" (#Apply (#Product Text Text) List) - (#Product ## "lux;defs" + (#Product ## "lux.defs" (#Apply (#Product Text Def) List) - (#Product ## "lux;imports" + (#Product ## "lux.imports" (#Apply Text List) - (#Product ## "lux;tags" + (#Product ## "lux.tags" (#Apply (#Product Text (#Product Nat (#Product (#Apply Ident List) (#Product Bool Type)))) List) - (#Product ## "lux;types" + (#Product ## "lux.types" (#Apply (#Product Text (#Product (#Apply Ident List) (#Product Bool Type))) List) - (#Product ## "lux;module-annotations" + (#Product ## "lux.module-annotations" Code Module-State)) )))))) @@ -720,27 +720,27 @@ ## #host Void}) ("lux def" Compiler (#Named ["lux" "Compiler"] - (#Product ## "lux;info" + (#Product ## "lux.info" Info - (#Product ## "lux;source" + (#Product ## "lux.source" Source - (#Product ## "lux;cursor" + (#Product ## "lux.cursor" Cursor - (#Product ## "lux;current-module" + (#Product ## "lux.current-module" (#Apply Text Maybe) - (#Product ## "lux;modules" + (#Product ## "lux.modules" (#Apply (#Product Text Module) List) - (#Product ## "lux;scopes" + (#Product ## "lux.scopes" (#Apply Scope List) - (#Product ## "lux;type-context" + (#Product ## "lux.type-context" Type-Context - (#Product ## "lux;expected" + (#Product ## "lux.expected" (#Apply Type Maybe) - (#Product ## "lux;seed" + (#Product ## "lux.seed" Nat (#Product ## scope-type-vars (#Apply Nat List) - ## "lux;host" + ## "lux.host" Void))))))))))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "info") @@ -776,7 +776,7 @@ These computations may fail, or modify the state of the compiler.")] (#Cons [(tag$ ["lux" "type-args"]) - (tuple$ (#Cons (text$ "a") #;Nil))] + (tuple$ (#Cons (text$ "a") #Nil))] default-def-meta-exported)))) ## (type: Macro @@ -826,7 +826,7 @@ ("lux case" tokens {(#Cons lhs (#Cons rhs (#Cons body #Nil))) (return (#Cons (form$ (#Cons (text$ "lux case") - (#Cons rhs (#Cons (record$ (#;Cons [lhs body] #Nil)) #Nil)))) + (#Cons rhs (#Cons (record$ (#Cons [lhs body] #Nil)) #Nil)))) #Nil)) _ @@ -1003,612 +1003,612 @@ (record$ default-macro-meta)) (def:'' (macro:' tokens) - default-macro-meta - Macro - ("lux case" tokens - {(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - ))) - #Nil)) - - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (tag$ ["" "export"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) - #Nil)) - - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (tag$ ["" "export"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta meta-data) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) - #Nil)) + default-macro-meta + Macro + ("lux case" tokens + {(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + ))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta meta-data) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) - _ - (fail "Wrong syntax for macro:'")})) + _ + (fail "Wrong syntax for macro:'")})) (macro:' #export (comment tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Throws away any code given to it. + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Throws away any code given to it. ## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor. (comment 1 2 3 4)")] - #;Nil) - (return #Nil)) + #Nil) + (return #Nil)) (macro:' ($' tokens) - ("lux case" tokens - {(#Cons x #Nil) - (return tokens) + ("lux case" tokens + {(#Cons x #Nil) + (return tokens) - (#Cons x (#Cons y xs)) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) - (#Cons (form$ (#Cons (tag$ ["lux" "Apply"]) - (#Cons y (#Cons x #Nil)))) - xs))) - #Nil)) + (#Cons x (#Cons y xs)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) + (#Cons (form$ (#Cons (tag$ ["lux" "Apply"]) + (#Cons y (#Cons x #Nil)))) + xs))) + #Nil)) - _ - (fail "Wrong syntax for $'")})) + _ + (fail "Wrong syntax for $'")})) (def:'' (map f xs) - #;Nil - (#UnivQ #Nil - (#UnivQ #Nil - (#Function (#Function (#Bound +3) (#Bound +1)) - (#Function ($' List (#Bound +3)) - ($' List (#Bound +1)))))) - ("lux case" xs - {#Nil - #Nil + #Nil + (#UnivQ #Nil + (#UnivQ #Nil + (#Function (#Function (#Bound +3) (#Bound +1)) + (#Function ($' List (#Bound +3)) + ($' List (#Bound +1)))))) + ("lux case" xs + {#Nil + #Nil - (#Cons x xs') - (#Cons (f x) (map f xs'))})) + (#Cons x xs') + (#Cons (f x) (map f xs'))})) (def:'' RepEnv - #;Nil - Type - ($' List (#Product Text Code))) + #Nil + Type + ($' List (#Product Text Code))) (def:'' (make-env xs ys) - #;Nil - (#Function ($' List Text) (#Function ($' List Code) RepEnv)) - ("lux case" [xs ys] - {[(#Cons x xs') (#Cons y ys')] - (#Cons [x y] (make-env xs' ys')) + #Nil + (#Function ($' List Text) (#Function ($' List Code) RepEnv)) + ("lux case" [xs ys] + {[(#Cons x xs') (#Cons y ys')] + (#Cons [x y] (make-env xs' ys')) - _ - #Nil})) + _ + #Nil})) (def:'' (text/= x y) - #;Nil - (#Function Text (#Function Text Bool)) - ("lux text =" x y)) + #Nil + (#Function Text (#Function Text Bool)) + ("lux text =" x y)) (def:'' (get-rep key env) - #;Nil - (#Function Text (#Function RepEnv ($' Maybe Code))) - ("lux case" env - {#Nil - #None + #Nil + (#Function Text (#Function RepEnv ($' Maybe Code))) + ("lux case" env + {#Nil + #None - (#Cons [k v] env') - ("lux case" (text/= k key) - {true - (#Some v) + (#Cons [k v] env') + ("lux case" (text/= k key) + {true + (#Some v) - false - (get-rep key env')})})) + false + (get-rep key env')})})) (def:'' (replace-syntax reps syntax) - #;Nil - (#Function RepEnv (#Function Code Code)) - ("lux case" syntax - {[_ (#Symbol "" name)] - ("lux case" (get-rep name reps) - {(#Some replacement) - replacement + #Nil + (#Function RepEnv (#Function Code Code)) + ("lux case" syntax + {[_ (#Symbol "" name)] + ("lux case" (get-rep name reps) + {(#Some replacement) + replacement - #None - syntax}) + #None + syntax}) - [meta (#Form parts)] - [meta (#Form (map (replace-syntax reps) parts))] + [meta (#Form parts)] + [meta (#Form (map (replace-syntax reps) parts))] - [meta (#Tuple members)] - [meta (#Tuple (map (replace-syntax reps) members))] + [meta (#Tuple members)] + [meta (#Tuple (map (replace-syntax reps) members))] - [meta (#Record slots)] - [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) - (function'' [slot] - ("lux case" slot - {[k v] - [(replace-syntax reps k) (replace-syntax reps v)]}))) - slots))] - - _ - syntax}) - ) + [meta (#Record slots)] + [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [slot] + ("lux case" slot + {[k v] + [(replace-syntax reps k) (replace-syntax reps v)]}))) + slots))] + + _ + syntax}) + ) (def:'' (update-bounds code) - #;Nil - (#Function Code Code) - ("lux case" code - {[_ (#Tuple members)] - (tuple$ (map update-bounds members)) + #Nil + (#Function Code Code) + ("lux case" code + {[_ (#Tuple members)] + (tuple$ (map update-bounds members)) - [_ (#Record pairs)] - (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) - (function'' [pair] - (let'' [name val] pair - [name (update-bounds val)]))) - pairs)) + [_ (#Record pairs)] + (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [pair] + (let'' [name val] pair + [name (update-bounds val)]))) + pairs)) - [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] - (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux nat +" +2 idx)) #Nil))) + [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux nat +" +2 idx)) #Nil))) - [_ (#Form members)] - (form$ (map update-bounds members)) + [_ (#Form members)] + (form$ (map update-bounds members)) - _ - code})) + _ + code})) (def:'' (parse-quantified-args args next) - #;Nil - ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) - (#Function ($' List Code) - (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta)) - (#Apply ($' List Code) Meta) - )) - ("lux case" args - {#Nil - (next #Nil) - - (#Cons [_ (#Symbol "" arg-name)] args') - (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + #Nil + ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) + (#Function ($' List Code) + (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta)) + (#Apply ($' List Code) Meta) + )) + ("lux case" args + {#Nil + (next #Nil) - _ - (fail "Expected symbol.")} - )) + (#Cons [_ (#Symbol "" arg-name)] args') + (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + + _ + (fail "Expected symbol.")} + )) (def:'' (make-bound idx) - #;Nil - (#Function Nat Code) - (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil)))) + #Nil + (#Function Nat Code) + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil)))) (def:'' (list/fold f init xs) - #;Nil - ## (All [a b] (-> (-> b a a) a (List b) a)) - (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1) - (#Function (#Bound +3) - (#Bound +3))) - (#Function (#Bound +3) - (#Function ($' List (#Bound +1)) - (#Bound +3)))))) - ("lux case" xs - {#Nil - init + #Nil + ## (All [a b] (-> (-> b a a) a (List b) a)) + (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1) + (#Function (#Bound +3) + (#Bound +3))) + (#Function (#Bound +3) + (#Function ($' List (#Bound +1)) + (#Bound +3)))))) + ("lux case" xs + {#Nil + init - (#Cons x xs') - (list/fold f (f x init) xs')})) + (#Cons x xs') + (list/fold f (f x init) xs')})) (def:'' (list/size list) - #;Nil - (#UnivQ #Nil - (#Function ($' List (#Bound +1)) Nat)) - (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list)) + #Nil + (#UnivQ #Nil + (#Function ($' List (#Bound +1)) Nat)) + (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list)) (macro:' #export (All tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Universal quantification. - (All [a] - (-> a a)) - - ## A name can be provided, to specify a recursive type. - (All List [a] - (| Unit - [a (List a)]))")] - #;Nil) - (let'' [self-name tokens] ("lux case" tokens - {(#Cons [_ (#Symbol "" self-name)] tokens) - [self-name tokens] - - _ - ["" tokens]}) - ("lux case" tokens - {(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args - (function'' [names] - (let'' body' (list/fold ("lux check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "UnivQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons ("lux case" [(text/= "" self-name) names] - {[true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound ("lux nat *" - +2 ("lux nat -" - (list/size names) - +1)))] - #Nil) - body')}) - #Nil))))) - - _ - (fail "Wrong syntax for All")}) - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Universal quantification. + (All [a] + (-> a a)) + + ## A name can be provided, to specify a recursive type. + (All List [a] + (| Unit + [a (List a)]))")] + #Nil) + (let'' [self-name tokens] ("lux case" tokens + {(#Cons [_ (#Symbol "" self-name)] tokens) + [self-name tokens] + + _ + ["" tokens]}) + ("lux case" tokens + {(#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse-quantified-args args + (function'' [names] + (let'' body' (list/fold ("lux check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "UnivQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons ("lux case" [(text/= "" self-name) names] + {[true _] + body' + + [_ #Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound ("lux nat *" + +2 ("lux nat -" + (list/size names) + +1)))] + #Nil) + body')}) + #Nil))))) + + _ + (fail "Wrong syntax for All")}) + )) (macro:' #export (Ex tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Existential quantification. - (Ex [a] - [(Codec Text a) - a]) - - ## A name can be provided, to specify a recursive type. - (Ex Self [a] - [(Codec Text a) - a - (List (Self a))])")] - #;Nil) - (let'' [self-name tokens] ("lux case" tokens - {(#Cons [_ (#Symbol "" self-name)] tokens) - [self-name tokens] - - _ - ["" tokens]}) - ("lux case" tokens - {(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args - (function'' [names] - (let'' body' (list/fold ("lux check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "ExQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons ("lux case" [(text/= "" self-name) names] - {[true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound ("lux nat *" - +2 ("lux nat -" - (list/size names) - +1)))] - #Nil) - body')}) - #Nil))))) - - _ - (fail "Wrong syntax for Ex")}) - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Existential quantification. + (Ex [a] + [(Codec Text a) + a]) + + ## A name can be provided, to specify a recursive type. + (Ex Self [a] + [(Codec Text a) + a + (List (Self a))])")] + #Nil) + (let'' [self-name tokens] ("lux case" tokens + {(#Cons [_ (#Symbol "" self-name)] tokens) + [self-name tokens] + + _ + ["" tokens]}) + ("lux case" tokens + {(#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse-quantified-args args + (function'' [names] + (let'' body' (list/fold ("lux check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "ExQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons ("lux case" [(text/= "" self-name) names] + {[true _] + body' + + [_ #Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound ("lux nat *" + +2 ("lux nat -" + (list/size names) + +1)))] + #Nil) + body')}) + #Nil))))) + + _ + (fail "Wrong syntax for Ex")}) + )) (def:'' (list/reverse list) - #;Nil - (All [a] (#Function ($' List a) ($' List a))) - (list/fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) - (function'' [head tail] (#Cons head tail))) - #Nil - list)) + #Nil + (All [a] (#Function ($' List a) ($' List a))) + (list/fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) + (function'' [head tail] (#Cons head tail))) + #Nil + list)) (macro:' #export (-> tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Function types: + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Function types: (-> Int Int Int) ## This is the type of a function that takes 2 Ints and returns an Int.")] - #;Nil) - ("lux case" (list/reverse tokens) - {(#Cons output inputs) - (return (#Cons (list/fold ("lux check" (#Function Code (#Function Code Code)) - (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) - output - inputs) - #Nil)) - - _ - (fail "Wrong syntax for ->")})) + #Nil) + ("lux case" (list/reverse tokens) + {(#Cons output inputs) + (return (#Cons (list/fold ("lux check" (#Function Code (#Function Code Code)) + (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) + output + inputs) + #Nil)) + + _ + (fail "Wrong syntax for ->")})) (macro:' #export (list xs) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## List-construction macro. + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## List-construction macro. (list 1 2 3)")] - #;Nil) - (return (#Cons (list/fold (function'' [head tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) - #Nil)))) - (tag$ ["lux" "Nil"]) - (list/reverse xs)) - #Nil))) + #Nil) + (return (#Cons (list/fold (function'' [head tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) + #Nil)))) + (tag$ ["lux" "Nil"]) + (list/reverse xs)) + #Nil))) (macro:' #export (list& xs) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## List-construction macro, with the last element being a tail-list. + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## List-construction macro, with the last element being a tail-list. ## In other words, this macro prepends elements to another list. (list& 1 2 3 (list 4 5 6))")] - #;Nil) - ("lux case" (list/reverse xs) - {(#Cons last init) - (return (list (list/fold (function'' [head tail] - (form$ (list (tag$ ["lux" "Cons"]) - (tuple$ (list head tail))))) - last - init))) + #Nil) + ("lux case" (list/reverse xs) + {(#Cons last init) + (return (list (list/fold (function'' [head tail] + (form$ (list (tag$ ["lux" "Cons"]) + (tuple$ (list head tail))))) + last + init))) - _ - (fail "Wrong syntax for list&")})) + _ + (fail "Wrong syntax for list&")})) (macro:' #export (& tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Tuple types: - (& Text Int Bool) - - ## The empty tuple, a.k.a. Unit. - (&)")] - #;Nil) - ("lux case" (list/reverse tokens) - {#Nil - (return (list (tag$ ["lux" "Unit"]))) - - (#Cons last prevs) - (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) - last - prevs)))} - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Tuple types: + (& Text Int Bool) + + ## The empty tuple, a.k.a. Unit. + (&)")] + #Nil) + ("lux case" (list/reverse tokens) + {#Nil + (return (list (tag$ ["lux" "Unit"]))) + + (#Cons last prevs) + (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) + last + prevs)))} + )) (macro:' #export (| tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Variant types: - (| Text Int Bool) - - ## The empty tuple, a.k.a. Void. - (|)")] - #;Nil) - ("lux case" (list/reverse tokens) - {#Nil - (return (list (tag$ ["lux" "Void"]))) - - (#Cons last prevs) - (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) - last - prevs)))} - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Variant types: + (| Text Int Bool) + + ## The empty tuple, a.k.a. Void. + (|)")] + #Nil) + ("lux case" (list/reverse tokens) + {#Nil + (return (list (tag$ ["lux" "Void"]))) + + (#Cons last prevs) + (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) + last + prevs)))} + )) (macro:' (function' tokens) - (let'' [name tokens'] ("lux case" tokens - {(#Cons [[_ (#Symbol ["" name])] tokens']) - [name tokens'] + (let'' [name tokens'] ("lux case" tokens + {(#Cons [[_ (#Symbol ["" name])] tokens']) + [name tokens'] - _ - ["" tokens]}) - ("lux case" tokens' - {(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) - ("lux case" args - {#Nil - (fail "function' requires a non-empty arguments tuple.") - - (#Cons [harg targs]) - (return (list (form$ (list (text$ "lux function") - (symbol$ ["" name]) - harg - (list/fold (function'' [arg body'] - (form$ (list (text$ "lux function") - (symbol$ ["" ""]) - arg - body'))) - body - (list/reverse targs))))))}) + _ + ["" tokens]}) + ("lux case" tokens' + {(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) + ("lux case" args + {#Nil + (fail "function' requires a non-empty arguments tuple.") + + (#Cons [harg targs]) + (return (list (form$ (list (text$ "lux function") + (symbol$ ["" name]) + harg + (list/fold (function'' [arg body'] + (form$ (list (text$ "lux function") + (symbol$ ["" ""]) + arg + body'))) + body + (list/reverse targs))))))}) - _ - (fail "Wrong syntax for function'")}))) + _ + (fail "Wrong syntax for function'")}))) (macro:' (def:''' tokens) - ("lux case" tokens - {(#Cons [[_ (#Tag ["" "export"])] - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") - type - (form$ (list (symbol$ ["lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))))))) - - (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") - type - body)) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))))))) - - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") - type - (form$ (list (symbol$ ["lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))))))) - - (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (list (form$ (list (text$ "lux def") - name - (form$ (list (text$ "lux check") type body)) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))))))) + ("lux case" tokens + {(#Cons [[_ (#Tag ["" "export"])] + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + (form$ (list (symbol$ ["lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) + + (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + body)) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) + + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + (form$ (list (symbol$ ["lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") type body)) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) - _ - (fail "Wrong syntax for def'''")} - )) + _ + (fail "Wrong syntax for def'''")} + )) (def:''' (as-pairs xs) - #;Nil - (All [a] (-> ($' List a) ($' List (& a a)))) - ("lux case" xs - {(#Cons x (#Cons y xs')) - (#Cons [x y] (as-pairs xs')) + #Nil + (All [a] (-> ($' List a) ($' List (& a a)))) + ("lux case" xs + {(#Cons x (#Cons y xs')) + (#Cons [x y] (as-pairs xs')) - _ - #Nil})) + _ + #Nil})) (macro:' (let' tokens) - ("lux case" tokens - {(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) - (return (list (list/fold ("lux check" (-> (& Code Code) Code - Code) - (function' [binding body] - ("lux case" binding - {[label value] - (form$ (list (text$ "lux case") value (record$ (list [label body]))))}))) - body - (list/reverse (as-pairs bindings))))) + ("lux case" tokens + {(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) + (return (list (list/fold ("lux check" (-> (& Code Code) Code + Code) + (function' [binding body] + ("lux case" binding + {[label value] + (form$ (list (text$ "lux case") value (record$ (list [label body]))))}))) + body + (list/reverse (as-pairs bindings))))) - _ - (fail "Wrong syntax for let'")})) + _ + (fail "Wrong syntax for let'")})) (def:''' (any? p xs) - #;Nil - (All [a] - (-> (-> a Bool) ($' List a) Bool)) - ("lux case" xs - {#Nil - false - - (#Cons x xs') - ("lux case" (p x) - {true true - false (any? p xs')})})) + #Nil + (All [a] + (-> (-> a Bool) ($' List a) Bool)) + ("lux case" xs + {#Nil + false + + (#Cons x xs') + ("lux case" (p x) + {true true + false (any? p xs')})})) (def:''' (wrap-meta content) - #;Nil - (-> Code Code) - (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0))) - content))) + #Nil + (-> Code Code) + (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0))) + content))) (def:''' (untemplate-list tokens) - #;Nil - (-> ($' List Code) Code) - ("lux case" tokens - {#Nil - (_ann (#Tag ["lux" "Nil"])) + #Nil + (-> ($' List Code) Code) + ("lux case" tokens + {#Nil + (_ann (#Tag ["lux" "Nil"])) - (#Cons [token tokens']) - (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))})) + (#Cons [token tokens']) + (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))})) (def:''' (list/compose xs ys) - #;Nil - (All [a] (-> ($' List a) ($' List a) ($' List a))) - ("lux case" xs - {(#Cons x xs') - (#Cons x (list/compose xs' ys)) + #Nil + (All [a] (-> ($' List a) ($' List a) ($' List a))) + ("lux case" xs + {(#Cons x xs') + (#Cons x (list/compose xs' ys)) - #Nil - ys})) + #Nil + ys})) (def:''' #export (splice-helper xs ys) - (#Cons [(tag$ ["lux" "hidden?"]) - (bool$ true)] - #;Nil) - (-> ($' List Code) ($' List Code) ($' List Code)) - ("lux case" xs - {(#Cons x xs') - (#Cons x (splice-helper xs' ys)) + (#Cons [(tag$ ["lux" "hidden?"]) + (bool$ true)] + #Nil) + (-> ($' List Code) ($' List Code) ($' List Code)) + ("lux case" xs + {(#Cons x xs') + (#Cons x (splice-helper xs' ys)) - #Nil - ys})) + #Nil + ys})) (def:''' (_$_joiner op a1 a2) - #;Nil - (-> Code Code Code Code) - ("lux case" op - {[_ (#Form parts)] - (form$ (list/compose parts (list a1 a2))) + #Nil + (-> Code Code Code Code) + ("lux case" op + {[_ (#Form parts)] + (form$ (list/compose parts (list a1 a2))) - _ - (form$ (list op a1 a2))})) + _ + (form$ (list op a1 a2))})) (macro:' #export (_$ tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Left-association for the application of binary functions over variadic arguments. - (_$ text/compose \"Hello, \" name \".\\nHow are you?\") - - ## => - (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] - #;Nil) - ("lux case" tokens - {(#Cons op tokens') - ("lux case" tokens' - {(#Cons first nexts) - (return (list (list/fold (_$_joiner op) first nexts))) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Left-association for the application of binary functions over variadic arguments. + (_$ text/compose \"Hello, \" name \".\\nHow are you?\") - _ - (fail "Wrong syntax for _$")}) - - _ - (fail "Wrong syntax for _$")})) + ## => + (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] + #Nil) + ("lux case" tokens + {(#Cons op tokens') + ("lux case" tokens' + {(#Cons first nexts) + (return (list (list/fold (_$_joiner op) first nexts))) + + _ + (fail "Wrong syntax for _$")}) + + _ + (fail "Wrong syntax for _$")})) (macro:' #export ($_ tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Right-association for the application of binary functions over variadic arguments. - ($_ text/compose \"Hello, \" name \".\\nHow are you?\") - - ## => - (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] - #;Nil) - ("lux case" tokens - {(#Cons op tokens') - ("lux case" (list/reverse tokens') - {(#Cons last prevs) - (return (list (list/fold (_$_joiner op) last prevs))) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Right-association for the application of binary functions over variadic arguments. + ($_ text/compose \"Hello, \" name \".\\nHow are you?\") - _ - (fail "Wrong syntax for $_")}) - - _ - (fail "Wrong syntax for $_")})) + ## => + (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] + #Nil) + ("lux case" tokens + {(#Cons op tokens') + ("lux case" (list/reverse tokens') + {(#Cons last prevs) + (return (list (list/fold (_$_joiner op) last prevs))) + + _ + (fail "Wrong syntax for $_")}) + + _ + (fail "Wrong syntax for $_")})) ## (sig: (Monad m) ## (: (All [a] (-> a (m a))) @@ -1616,639 +1616,644 @@ ## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) (def:''' Monad - (list& [(tag$ ["lux" "tags"]) - (tuple$ (list (text$ "wrap") (text$ "bind")))] - default-def-meta-unexported) - Type - (#Named ["lux" "Monad"] - (All [m] - (& (All [a] (-> a ($' m a))) - (All [a b] (-> (-> a ($' m b)) - ($' m a) - ($' m b))))))) + (list& [(tag$ ["lux" "tags"]) + (tuple$ (list (text$ "wrap") (text$ "bind")))] + default-def-meta-unexported) + Type + (#Named ["lux" "Monad"] + (All [m] + (& (All [a] (-> a ($' m a))) + (All [a b] (-> (-> a ($' m b)) + ($' m a) + ($' m b))))))) (def:''' Monad<Maybe> - #Nil - ($' Monad Maybe) - {#wrap - (function' [x] (#Some x)) - - #bind - (function' [f ma] - ("lux case" ma - {#None #None - (#Some a) (f a)}))}) + #Nil + ($' Monad Maybe) + {#wrap + (function' [x] (#Some x)) + + #bind + (function' [f ma] + ("lux case" ma + {#None #None + (#Some a) (f a)}))}) (def:''' Monad<Meta> - #Nil - ($' Monad Meta) - {#wrap - (function' [x] - (function' [state] - (#Right state x))) - - #bind - (function' [f ma] - (function' [state] - ("lux case" (ma state) - {(#Left msg) - (#Left msg) + #Nil + ($' Monad Meta) + {#wrap + (function' [x] + (function' [state] + (#Right state x))) + + #bind + (function' [f ma] + (function' [state] + ("lux case" (ma state) + {(#Left msg) + (#Left msg) - (#Right state' a) - (f a state')})))}) + (#Right state' a) + (f a state')})))}) (macro:' (do tokens) - ("lux case" tokens - {(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) - (let' [g!wrap (symbol$ ["" "wrap"]) - g!bind (symbol$ ["" " bind "]) - body' (list/fold ("lux check" (-> (& Code Code) Code Code) - (function' [binding body'] - (let' [[var value] binding] - ("lux case" var - {[_ (#Tag "" "let")] - (form$ (list (symbol$ ["lux" "let'"]) value body')) - - _ - (form$ (list g!bind - (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) - value))})))) - body - (list/reverse (as-pairs bindings)))] - (return (list (form$ (list (text$ "lux case") - monad - (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) - body']))))))) + ("lux case" tokens + {(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) + (let' [g!wrap (symbol$ ["" "wrap"]) + g!bind (symbol$ ["" " bind "]) + body' (list/fold ("lux check" (-> (& Code Code) Code Code) + (function' [binding body'] + (let' [[var value] binding] + ("lux case" var + {[_ (#Tag "" "let")] + (form$ (list (symbol$ ["lux" "let'"]) value body')) + + _ + (form$ (list g!bind + (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) + value))})))) + body + (list/reverse (as-pairs bindings)))] + (return (list (form$ (list (text$ "lux case") + monad + (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) + body']))))))) - _ - (fail "Wrong syntax for do")})) + _ + (fail "Wrong syntax for do")})) (def:''' (monad/map m f xs) - #Nil - ## (All [m a b] - ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) - (All [m a b] - (-> ($' Monad m) - (-> a ($' m b)) - ($' List a) - ($' m ($' List b)))) - (let' [{#;wrap wrap #;bind _} m] - ("lux case" xs - {#Nil - (wrap #Nil) - - (#Cons x xs') - (do m - [y (f x) - ys (monad/map m f xs')] - (wrap (#Cons y ys))) - }))) + #Nil + ## (All [m a b] + ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) + (All [m a b] + (-> ($' Monad m) + (-> a ($' m b)) + ($' List a) + ($' m ($' List b)))) + (let' [{#wrap wrap #bind _} m] + ("lux case" xs + {#Nil + (wrap #Nil) + + (#Cons x xs') + (do m + [y (f x) + ys (monad/map m f xs')] + (wrap (#Cons y ys))) + }))) (def:''' (monad/fold m f y xs) - #Nil - ## (All [m a b] - ## (-> (Monad m) (-> a b (m b)) b (List a) (m b))) - (All [m a b] - (-> ($' Monad m) - (-> a b ($' m b)) - b - ($' List a) - ($' m b))) - (let' [{#;wrap wrap #;bind _} m] - ("lux case" xs - {#Nil - (wrap y) - - (#Cons x xs') - (do m - [y' (f x y)] - (monad/fold m f y' xs')) - }))) + #Nil + ## (All [m a b] + ## (-> (Monad m) (-> a b (m b)) b (List a) (m b))) + (All [m a b] + (-> ($' Monad m) + (-> a b ($' m b)) + b + ($' List a) + ($' m b))) + (let' [{#wrap wrap #bind _} m] + ("lux case" xs + {#Nil + (wrap y) + + (#Cons x xs') + (do m + [y' (f x y)] + (monad/fold m f y' xs')) + }))) (macro:' #export (if tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "Picks which expression to evaluate based on a boolean test value. + (list [(tag$ ["lux" "doc"]) + (text$ "Picks which expression to evaluate based on a boolean test value. - (if true - \"Oh, yeah!\" - \"Aw hell naw!\") + (if true + \"Oh, yeah!\" + \"Aw hell naw!\") - => \"Oh, yeah!\"")]) - ("lux case" tokens - {(#Cons test (#Cons then (#Cons else #Nil))) - (return (list (form$ (list (text$ "lux case") test - (record$ (list [(bool$ true) then] - [(bool$ false) else])))))) + => \"Oh, yeah!\"")]) + ("lux case" tokens + {(#Cons test (#Cons then (#Cons else #Nil))) + (return (list (form$ (list (text$ "lux case") test + (record$ (list [(bool$ true) then] + [(bool$ false) else])))))) - _ - (fail "Wrong syntax for if")})) + _ + (fail "Wrong syntax for if")})) (def:''' (get k plist) - #Nil - (All [a] - (-> Text ($' List (& Text a)) ($' Maybe a))) - ("lux case" plist - {(#Cons [[k' v] plist']) - (if (text/= k k') - (#Some v) - (get k plist')) - - #Nil - #None})) + #Nil + (All [a] + (-> Text ($' List (& Text a)) ($' Maybe a))) + ("lux case" plist + {(#Cons [[k' v] plist']) + (if (text/= k k') + (#Some v) + (get k plist')) + + #Nil + #None})) (def:''' (put k v dict) - #Nil - (All [a] - (-> Text a ($' List (& Text a)) ($' List (& Text a)))) - ("lux case" dict - {#Nil - (list [k v]) - - (#Cons [[k' v'] dict']) - (if (text/= k k') - (#Cons [[k' v] dict']) - (#Cons [[k' v'] (put k v dict')]))})) + #Nil + (All [a] + (-> Text a ($' List (& Text a)) ($' List (& Text a)))) + ("lux case" dict + {#Nil + (list [k v]) + + (#Cons [[k' v'] dict']) + (if (text/= k k') + (#Cons [[k' v] dict']) + (#Cons [[k' v'] (put k v dict')]))})) (def:''' #export (log! message) - (list [(tag$ ["lux" "doc"]) - (text$ "Logs message to standard output. + (list [(tag$ ["lux" "doc"]) + (text$ "Logs message to standard output. - Useful for debugging.")]) - (-> Text Unit) - ("lux io log" message)) + Useful for debugging.")]) + (-> Text Unit) + ("lux io log" message)) (def:''' (text/compose x y) - #Nil - (-> Text Text Text) - ("lux text concat" x y)) + #Nil + (-> Text Text Text) + ("lux text concat" x y)) (def:''' (ident/encode ident) - #Nil - (-> Ident Text) - (let' [[module name] ident] - ("lux case" module - {"" name - _ ($_ text/compose module ";" name)}))) + #Nil + (-> Ident Text) + (let' [[module name] ident] + ("lux case" module + {"" name + _ ($_ text/compose module "." name)}))) (def:''' (get-meta tag def-meta) - #Nil - (-> Ident Code ($' Maybe Code)) - (let' [[prefix name] tag] - ("lux case" def-meta - {[_ (#Record def-meta)] - ("lux case" def-meta - {(#Cons [key value] def-meta') - ("lux case" key - {[_ (#Tag [prefix' name'])] - ("lux case" [(text/= prefix prefix') - (text/= name name')] - {[true true] - (#Some value) + #Nil + (-> Ident Code ($' Maybe Code)) + (let' [[prefix name] tag] + ("lux case" def-meta + {[_ (#Record def-meta)] + ("lux case" def-meta + {(#Cons [key value] def-meta') + ("lux case" key + {[_ (#Tag [prefix' name'])] + ("lux case" [(text/= prefix prefix') + (text/= name name')] + {[true true] + (#Some value) - _ - (get-meta tag (record$ def-meta'))}) + _ + (get-meta tag (record$ def-meta'))}) - _ - (get-meta tag (record$ def-meta'))}) + _ + (get-meta tag (record$ def-meta'))}) - #Nil - #None}) + #Nil + #None}) - _ - #None}))) + _ + #None}))) (def:''' (resolve-global-symbol ident state) - #Nil - (-> Ident ($' Meta Ident)) - (let' [[module name] ident - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] - ("lux case" (get module modules) - {(#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _}) - ("lux case" (get name defs) - {(#Some [def-type def-meta def-value]) - ("lux case" (get-meta ["lux" "alias"] def-meta) - {(#Some [_ (#Symbol real-name)]) - (#Right [state real-name]) + #Nil + (-> Ident ($' Meta Ident)) + (let' [[module name] ident + {#info info #source source #current-module _ #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + ("lux case" (get module modules) + {(#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _}) + ("lux case" (get name defs) + {(#Some [def-type def-meta def-value]) + ("lux case" (get-meta ["lux" "alias"] def-meta) + {(#Some [_ (#Symbol real-name)]) + (#Right [state real-name]) - _ - (#Right [state ident])}) + _ + (#Right [state ident])}) - #None - (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))}) - - #None - (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))}))) + #None + (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))}) + + #None + (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))}))) (def:''' (splice replace? untemplate elems) - #Nil - (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) - ("lux case" replace? - {true - ("lux case" (list/reverse elems) - {#Nil - (return (tag$ ["lux" "Nil"])) - - (#Cons lastI inits) - (do Monad<Meta> - [lastO ("lux case" lastI - {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - (wrap spliced) + #Nil + (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) + ("lux case" replace? + {true + ("lux case" (list/reverse elems) + {#Nil + (return (tag$ ["lux" "Nil"])) + + (#Cons lastI inits) + (do Monad<Meta> + [lastO ("lux case" lastI + {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap spliced) - _ - (do Monad<Meta> - [lastO (untemplate lastI)] - (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))})] - (monad/fold Monad<Meta> - (function' [leftI rightO] - ("lux case" leftI - {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) - spliced - rightO))) + _ + (do Monad<Meta> + [lastO (untemplate lastI)] + (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))})] + (monad/fold Monad<Meta> + (function' [leftI rightO] + ("lux case" leftI + {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) + spliced + rightO))) - _ - (do Monad<Meta> - [leftO (untemplate leftI)] - (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))})) - lastO - inits))}) - false - (do Monad<Meta> - [=elems (monad/map Monad<Meta> untemplate elems)] - (wrap (untemplate-list =elems)))})) + _ + (do Monad<Meta> + [leftO (untemplate leftI)] + (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))})) + lastO + inits))}) + false + (do Monad<Meta> + [=elems (monad/map Monad<Meta> untemplate elems)] + (wrap (untemplate-list =elems)))})) (def:''' (untemplate replace? subst token) - #Nil - (-> Bool Text Code ($' Meta Code)) - ("lux case" [replace? token] - {[_ [_ (#Bool value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) - - [_ [_ (#Nat value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) - - [_ [_ (#Int value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) + #Nil + (-> Bool Text Code ($' Meta Code)) + ("lux case" [replace? token] + {[_ [_ (#Bool value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) - [_ [_ (#Deg value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) - - [_ [_ (#Frac value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) - - [_ [_ (#Text value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) - - [false [_ (#Tag [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) - - [true [_ (#Tag [module name])]] - (let' [module' ("lux case" module - {"" - subst + [_ [_ (#Nat value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) - _ - module})] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) - - [true [_ (#Symbol [module name])]] - (do Monad<Meta> - [real-name ("lux case" module - {"" - (if (text/= "" subst) - (wrap [module name]) - (resolve-global-symbol [subst name])) + [_ [_ (#Int value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) - _ - (wrap [module name])}) - #let [[module name] real-name]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) + [_ [_ (#Deg value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) + + [_ [_ (#Frac value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) - [false [_ (#Symbol [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) + [_ [_ (#Text value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] - (return unquoted) + [false [_ (#Tag [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] - (untemplate false subst keep-quoted) + [true [_ (#Tag [module name])]] + (let' [module' ("lux case" module + {"" + subst - [_ [meta (#Form elems)]] - (do Monad<Meta> - [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] - (wrap [meta output'])) + _ + module})] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) - [_ [meta (#Tuple elems)]] - (do Monad<Meta> - [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] - (wrap [meta output'])) + [true [_ (#Symbol [module name])]] + (do Monad<Meta> + [real-name ("lux case" module + {"" + (if (text/= "" subst) + (wrap [module name]) + (resolve-global-symbol [subst name])) - [_ [_ (#Record fields)]] - (do Monad<Meta> - [=fields (monad/map Monad<Meta> - ("lux check" (-> (& Code Code) ($' Meta Code)) - (function' [kv] - (let' [[k v] kv] - (do Monad<Meta> - [=k (untemplate replace? subst k) - =v (untemplate replace? subst v)] - (wrap (tuple$ (list =k =v))))))) - fields)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))} - )) + _ + (wrap [module name])}) + #let [[module name] real-name]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) + + [false [_ (#Symbol [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) + + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] + (return unquoted) + + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] + (untemplate false subst keep-quoted) + + [_ [meta (#Form elems)]] + (do Monad<Meta> + [output (splice replace? (untemplate replace? subst) elems) + #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] + (wrap [meta output'])) + + [_ [meta (#Tuple elems)]] + (do Monad<Meta> + [output (splice replace? (untemplate replace? subst) elems) + #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] + (wrap [meta output'])) + + [_ [_ (#Record fields)]] + (do Monad<Meta> + [=fields (monad/map Monad<Meta> + ("lux check" (-> (& Code Code) ($' Meta Code)) + (function' [kv] + (let' [[k v] kv] + (do Monad<Meta> + [=k (untemplate replace? subst k) + =v (untemplate replace? subst v)] + (wrap (tuple$ (list =k =v))))))) + fields)] + (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))} + )) (macro:' #export (primitive tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Macro to treat define new primitive types. - (primitive \"java.lang.Object\") + (list [(tag$ ["lux" "doc"]) + (text$ "## Macro to treat define new primitive types. + (primitive \"java.lang.Object\") - (primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")]) - ("lux case" tokens - {(#Cons [_ (#Text class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + (primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")]) + ("lux case" tokens + {(#Cons [_ (#Text class-name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) - (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) + (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) - _ - (fail "Wrong syntax for primitive")})) + _ + (fail "Wrong syntax for primitive")})) (def:'' (current-module-name state) - #Nil - ($' Meta Text) - ("lux case" state - {{#info info #source source #current-module current-module #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} - ("lux case" current-module - {(#;Some module-name) - (#Right [state module-name]) + #Nil + ($' Meta Text) + ("lux case" state + {{#info info #source source #current-module current-module #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + ("lux case" current-module + {(#Some module-name) + (#Right [state module-name]) - _ - (#Left "Cannot get the module name without a module!")} - )})) + _ + (#Left "Cannot get the module name without a module!")} + )})) (macro:' #export (` tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. - ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. - (` (def: (~ name) - (function [(~@ args)] - (~ body))))")]) - ("lux case" tokens - {(#Cons template #Nil) - (do Monad<Meta> - [current-module current-module-name - =template (untemplate true current-module template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. + (` (def: (~ name) + (function [(~@ args)] + (~ body))))")]) + ("lux case" tokens + {(#Cons template #Nil) + (do Monad<Meta> + [current-module current-module-name + =template (untemplate true current-module template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for `")})) + _ + (fail "Wrong syntax for `")})) (macro:' #export (`' tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. - (`' (def: (~ name) - (function [(~@ args)] - (~ body))))")]) - ("lux case" tokens - {(#Cons template #Nil) - (do Monad<Meta> - [=template (untemplate true "" template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (`' (def: (~ name) + (function [(~@ args)] + (~ body))))")]) + ("lux case" tokens + {(#Cons template #Nil) + (do Monad<Meta> + [=template (untemplate true "" template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for `")})) + _ + (fail "Wrong syntax for `")})) (macro:' #export (' tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Quotation as a macro. - (' \"YOLO\")")]) - ("lux case" tokens - {(#Cons template #Nil) - (do Monad<Meta> - [=template (untemplate false "" template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Quotation as a macro. + (' \"YOLO\")")]) + ("lux case" tokens + {(#Cons template #Nil) + (do Monad<Meta> + [=template (untemplate false "" template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for '")})) + _ + (fail "Wrong syntax for '")})) (macro:' #export (|> tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Piping macro. - (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\")) - - ## => - (fold text/compose \"\" - (interpose \" \" - (map int/encode elems)))")]) - ("lux case" tokens - {(#Cons [init apps]) - (return (list (list/fold ("lux check" (-> Code Code Code) - (function' [app acc] - ("lux case" app - {[_ (#Tuple parts)] - (tuple$ (list/compose parts (list acc))) - - [_ (#Form parts)] - (form$ (list/compose parts (list acc))) - - _ - (` ((~ app) (~ acc)))}))) - init - apps))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Piping macro. + (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\")) + + ## => + (fold text/compose \"\" + (interpose \" \" + (map int/encode elems)))")]) + ("lux case" tokens + {(#Cons [init apps]) + (return (list (list/fold ("lux check" (-> Code Code Code) + (function' [app acc] + ("lux case" app + {[_ (#Tuple parts)] + (tuple$ (list/compose parts (list acc))) - _ - (fail "Wrong syntax for |>")})) + [_ (#Form parts)] + (form$ (list/compose parts (list acc))) + + _ + (` ((~ app) (~ acc)))}))) + init + apps))) + + _ + (fail "Wrong syntax for |>")})) (macro:' #export (<| tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Reverse piping macro. - (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems) - - ## => - (fold text/compose \"\" - (interpose \" \" - (map int/encode elems)))")]) - ("lux case" (list/reverse tokens) - {(#Cons [init apps]) - (return (list (list/fold ("lux check" (-> Code Code Code) - (function' [app acc] - ("lux case" app - {[_ (#Tuple parts)] - (tuple$ (list/compose parts (list acc))) - - [_ (#Form parts)] - (form$ (list/compose parts (list acc))) - - _ - (` ((~ app) (~ acc)))}))) - init - apps))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Reverse piping macro. + (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems) + + ## => + (fold text/compose \"\" + (interpose \" \" + (map int/encode elems)))")]) + ("lux case" (list/reverse tokens) + {(#Cons [init apps]) + (return (list (list/fold ("lux check" (-> Code Code Code) + (function' [app acc] + ("lux case" app + {[_ (#Tuple parts)] + (tuple$ (list/compose parts (list acc))) + + [_ (#Form parts)] + (form$ (list/compose parts (list acc))) + + _ + (` ((~ app) (~ acc)))}))) + init + apps))) - _ - (fail "Wrong syntax for <|")})) + _ + (fail "Wrong syntax for <|")})) (def:''' (compose f g) - (list [(tag$ ["lux" "doc"]) - (text$ "Function composition.")]) - (All [a b c] - (-> (-> b c) (-> a b) (-> a c))) - (function' [x] (f (g x)))) + (list [(tag$ ["lux" "doc"]) + (text$ "Function composition.")]) + (All [a b c] + (-> (-> b c) (-> a b) (-> a c))) + (function' [x] (f (g x)))) (def:''' (get-ident x) - #Nil - (-> Code ($' Maybe Ident)) - ("lux case" x - {[_ (#Symbol sname)] - (#Some sname) + #Nil + (-> Code ($' Maybe Ident)) + ("lux case" x + {[_ (#Symbol sname)] + (#Some sname) - _ - #None})) + _ + #None})) (def:''' (get-tag x) - #Nil - (-> Code ($' Maybe Ident)) - ("lux case" x - {[_ (#Tag sname)] - (#Some sname) + #Nil + (-> Code ($' Maybe Ident)) + ("lux case" x + {[_ (#Tag sname)] + (#Some sname) - _ - #None})) + _ + #None})) (def:''' (get-name x) - #Nil - (-> Code ($' Maybe Text)) - ("lux case" x - {[_ (#Symbol "" sname)] - (#Some sname) + #Nil + (-> Code ($' Maybe Text)) + ("lux case" x + {[_ (#Symbol "" sname)] + (#Some sname) - _ - #None})) + _ + #None})) (def:''' (tuple->list tuple) - #Nil - (-> Code ($' Maybe ($' List Code))) - ("lux case" tuple - {[_ (#Tuple members)] - (#Some members) + #Nil + (-> Code ($' Maybe ($' List Code))) + ("lux case" tuple + {[_ (#Tuple members)] + (#Some members) - _ - #None})) + _ + #None})) (def:''' (apply-template env template) - #Nil - (-> RepEnv Code Code) - ("lux case" template - {[_ (#Symbol "" sname)] - ("lux case" (get-rep sname env) - {(#Some subst) - subst + #Nil + (-> RepEnv Code Code) + ("lux case" template + {[_ (#Symbol "" sname)] + ("lux case" (get-rep sname env) + {(#Some subst) + subst - _ - template}) + _ + template}) - [meta (#Tuple elems)] - [meta (#Tuple (map (apply-template env) elems))] + [meta (#Tuple elems)] + [meta (#Tuple (map (apply-template env) elems))] - [meta (#Form elems)] - [meta (#Form (map (apply-template env) elems))] + [meta (#Form elems)] + [meta (#Form (map (apply-template env) elems))] - [meta (#Record members)] - [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code)) - (function' [kv] - (let' [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) - members))] + [meta (#Record members)] + [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code)) + (function' [kv] + (let' [[slot value] kv] + [(apply-template env slot) (apply-template env value)]))) + members))] - _ - template})) + _ + template})) (def:''' (join-map f xs) - #Nil - (All [a b] - (-> (-> a ($' List b)) ($' List a) ($' List b))) - ("lux case" xs - {#Nil - #Nil + #Nil + (All [a b] + (-> (-> a ($' List b)) ($' List a) ($' List b))) + ("lux case" xs + {#Nil + #Nil - (#Cons [x xs']) - (list/compose (f x) (join-map f xs'))})) + (#Cons [x xs']) + (list/compose (f x) (join-map f xs'))})) (def:''' (every? p xs) - #Nil - (All [a] - (-> (-> a Bool) ($' List a) Bool)) - (list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs)) + #Nil + (All [a] + (-> (-> a Bool) ($' List a) Bool)) + (list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs)) (macro:' #export (do-template tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. - (do-template [<name> <diff>] - [(def: #export <name> - (-> Int Int) - (i/+ <diff>))] - - [i/inc 1] - [i/dec -1])")]) - ("lux case" tokens - {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) - ("lux case" [(monad/map Monad<Maybe> get-name bindings) - (monad/map Monad<Maybe> tuple->list data)] - {[(#Some bindings') (#Some data')] - (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (map (apply-template env) templates))) - num-bindings (list/size bindings')] - (if (every? (function' [sample] ("lux nat =" num-bindings sample)) - (map list/size data')) - (|> data' - (join-map (compose apply (make-env bindings'))) - return) - (fail "Irregular arguments tuples for do-template."))) + (list [(tag$ ["lux" "doc"]) + (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. + (do-template [<name> <diff>] + [(def: #export <name> + (-> Int Int) + (i/+ <diff>))] + + [i/inc 1] + [i/dec -1])")]) + ("lux case" tokens + {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) + ("lux case" [(monad/map Monad<Maybe> get-name bindings) + (monad/map Monad<Maybe> tuple->list data)] + {[(#Some bindings') (#Some data')] + (let' [apply ("lux check" (-> RepEnv ($' List Code)) + (function' [env] (map (apply-template env) templates))) + num-bindings (list/size bindings')] + (if (every? (function' [sample] ("lux nat =" num-bindings sample)) + (map list/size data')) + (|> data' + (join-map (compose apply (make-env bindings'))) + return) + (fail "Irregular arguments tuples for do-template."))) - _ - (fail "Wrong syntax for do-template")}) + _ + (fail "Wrong syntax for do-template")}) - _ - (fail "Wrong syntax for do-template")})) + _ + (fail "Wrong syntax for do-template")})) (do-template [<type> <eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name> <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] [(def:''' #export (<eq-name> test subject) - (list [(tag$ ["lux" "doc"]) (text$ <eq-doc>)]) - (-> <type> <type> Bool) - (<eq-proc> subject test)) + (list [(tag$ ["lux" "doc"]) + (text$ <eq-doc>)]) + (-> <type> <type> Bool) + (<eq-proc> subject test)) (def:''' #export (<lt-name> test subject) - (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)]) - (-> <type> <type> Bool) - (<lt-proc> subject test)) + (list [(tag$ ["lux" "doc"]) + (text$ <<-doc>)]) + (-> <type> <type> Bool) + (<lt-proc> subject test)) (def:''' #export (<lte-name> test subject) - (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)]) - (-> <type> <type> Bool) - (if (<lt-proc> subject test) - true - (<eq-proc> subject test))) + (list [(tag$ ["lux" "doc"]) + (text$ <<=-doc>)]) + (-> <type> <type> Bool) + (if (<lt-proc> subject test) + true + (<eq-proc> subject test))) (def:''' #export (<gt-name> test subject) - (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)]) - (-> <type> <type> Bool) - (<lt-proc> test subject)) + (list [(tag$ ["lux" "doc"]) + (text$ <>-doc>)]) + (-> <type> <type> Bool) + (<lt-proc> test subject)) (def:''' #export (<gte-name> test subject) - (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)]) - (-> <type> <type> Bool) - (if (<lt-proc> test subject) - true - (<eq-proc> subject test)))] + (list [(tag$ ["lux" "doc"]) + (text$ <>=-doc>)]) + (-> <type> <type> Bool) + (if (<lt-proc> test subject) + true + (<eq-proc> subject test)))] [ Nat "lux nat =" "lux nat <" n/= n/< n/<= n/> n/>= "Nat(ural) equality." "Nat(ural) less-than." "Nat(ural) less-than-equal." "Nat(ural) greater-than." "Nat(ural) greater-than-equal."] @@ -2265,9 +2270,10 @@ (do-template [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) - (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) - (-> <type> <type> <type>) - (<op> subject param))] + (list [(tag$ ["lux" "doc"]) + (text$ <doc>)]) + (-> <type> <type> <type>) + (<op> subject param))] [ Nat n/+ "lux nat +" "Nat(ural) addition."] [ Nat n/- "lux nat -" "Nat(ural) substraction."] @@ -2296,9 +2302,10 @@ (do-template [<type> <name> <op> <doc>] [(def:''' #export (<name> param subject) - (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) - (-> Nat <type> <type>) - (<op> subject param))] + (list [(tag$ ["lux" "doc"]) + (text$ <doc>)]) + (-> Nat <type> <type>) + (<op> subject param))] [ Deg d/scale "lux deg scale" "Deg(ree) scale."] [ Deg d/reciprocal "lux deg reciprocal" "Deg(ree) reciprocal."] @@ -2306,11 +2313,12 @@ (do-template [<name> <type> <test> <doc>] [(def:''' #export (<name> left right) - (list [(tag$ ["lux" "doc"]) (text$ <doc>)]) - (-> <type> <type> <type>) - (if (<test> right left) - left - right))] + (list [(tag$ ["lux" "doc"]) + (text$ <doc>)]) + (-> <type> <type> <type>) + (if (<test> right left) + left + right))] [n/min Nat n/< "Nat(ural) minimum."] [n/max Nat n/> "Nat(ural) maximum."] @@ -2326,903 +2334,903 @@ ) (def:''' (bool/encode x) - #Nil - (-> Bool Text) - (if x "true" "false")) + #Nil + (-> Bool Text) + (if x "true" "false")) (def:''' (digit-to-text digit) - #Nil - (-> Nat Text) - ("lux case" digit - {+0 "0" - +1 "1" +2 "2" +3 "3" - +4 "4" +5 "5" +6 "6" - +7 "7" +8 "8" +9 "9" - _ ("lux io error" "undefined")})) + #Nil + (-> Nat Text) + ("lux case" digit + {+0 "0" + +1 "1" +2 "2" +3 "3" + +4 "4" +5 "5" +6 "6" + +7 "7" +8 "8" +9 "9" + _ ("lux io error" "undefined")})) (def:''' (nat/encode value) - #Nil - (-> Nat Text) - ("lux case" value - {+0 - "+0" + #Nil + (-> Nat Text) + ("lux case" value + {+0 + "+0" - _ - (let' [loop ("lux check" (-> Nat Text Text) - (function' recur [input output] - (if (n/= +0 input) - (text/compose "+" output) - (recur (n// +10 input) - (text/compose (|> input (n/% +10) digit-to-text) - output)))))] - (loop value ""))})) + _ + (let' [loop ("lux check" (-> Nat Text Text) + (function' recur [input output] + (if (n/= +0 input) + (text/compose "+" output) + (recur (n// +10 input) + (text/compose (|> input (n/% +10) digit-to-text) + output)))))] + (loop value ""))})) (def:''' (int/abs value) - #Nil - (-> Int Int) - (if (i/< 0 value) - (i/* -1 value) - value)) + #Nil + (-> Int Int) + (if (i/< 0 value) + (i/* -1 value) + value)) (def:''' (int/encode value) - #Nil - (-> Int Text) - (if (i/= 0 value) - "0" - (let' [sign (if (i/> 0 value) - "" - "-")] - (("lux check" (-> Int Text Text) - (function' recur [input output] - (if (i/= 0 input) - (text/compose sign output) - (recur (i// 10 input) - (text/compose (|> input (i/% 10) ("lux coerce" Nat) digit-to-text) - output))))) - (|> value (i// 10) int/abs) - (|> value (i/% 10) int/abs ("lux coerce" Nat) digit-to-text))))) + #Nil + (-> Int Text) + (if (i/= 0 value) + "0" + (let' [sign (if (i/> 0 value) + "" + "-")] + (("lux check" (-> Int Text Text) + (function' recur [input output] + (if (i/= 0 input) + (text/compose sign output) + (recur (i// 10 input) + (text/compose (|> input (i/% 10) ("lux coerce" Nat) digit-to-text) + output))))) + (|> value (i// 10) int/abs) + (|> value (i/% 10) int/abs ("lux coerce" Nat) digit-to-text))))) (def:''' (frac/encode x) - #Nil - (-> Frac Text) - ("lux frac encode" x)) + #Nil + (-> Frac Text) + ("lux frac encode" x)) (def:''' (multiple? div n) - #Nil - (-> Nat Nat Bool) - (|> n (n/% div) (n/= +0))) + #Nil + (-> Nat Nat Bool) + (|> n (n/% div) (n/= +0))) (def:''' #export (not x) - (list [(tag$ ["lux" "doc"]) - (text$ "## Boolean negation. + (list [(tag$ ["lux" "doc"]) + (text$ "## Boolean negation. - (not true) => false + (not true) => false - (not false) => true")]) - (-> Bool Bool) - (if x false true)) + (not false) => true")]) + (-> Bool Bool) + (if x false true)) (def:''' (find-macro' modules current-module module name) - #Nil - (-> ($' List (& Text Module)) - Text Text Text - ($' Maybe Macro)) - (do Monad<Maybe> - [$module (get module modules) - gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] - (get name bindings))] - (let' [[def-type def-meta def-value] ("lux check" Def gdef)] - ("lux case" (get-meta ["lux" "macro?"] def-meta) - {(#Some [_ (#Bool true)]) - ("lux case" (get-meta ["lux" "export?"] def-meta) - {(#Some [_ (#Bool true)]) - (#Some ("lux coerce" Macro def-value)) + #Nil + (-> ($' List (& Text Module)) + Text Text Text + ($' Maybe Macro)) + (do Monad<Maybe> + [$module (get module modules) + gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] + (get name bindings))] + (let' [[def-type def-meta def-value] ("lux check" Def gdef)] + ("lux case" (get-meta ["lux" "macro?"] def-meta) + {(#Some [_ (#Bool true)]) + ("lux case" (get-meta ["lux" "export?"] def-meta) + {(#Some [_ (#Bool true)]) + (#Some ("lux coerce" Macro def-value)) - _ - (if (text/= module current-module) - (#Some ("lux coerce" Macro def-value)) - #None)}) - - _ - ("lux case" (get-meta ["lux" "alias"] def-meta) - {(#Some [_ (#Symbol [r-module r-name])]) - (find-macro' modules current-module r-module r-name) + _ + (if (text/= module current-module) + (#Some ("lux coerce" Macro def-value)) + #None)}) + + _ + ("lux case" (get-meta ["lux" "alias"] def-meta) + {(#Some [_ (#Symbol [r-module r-name])]) + (find-macro' modules current-module r-module r-name) - _ - #None})} + _ + #None})} + )) )) - )) (def:''' (normalize ident) - #Nil - (-> Ident ($' Meta Ident)) - ("lux case" ident - {["" name] - (do Monad<Meta> - [module-name current-module-name] - (wrap [module-name name])) + #Nil + (-> Ident ($' Meta Ident)) + ("lux case" ident + {["" name] + (do Monad<Meta> + [module-name current-module-name] + (wrap [module-name name])) - _ - (return ident)})) + _ + (return ident)})) (def:''' (find-macro ident) - #Nil - (-> Ident ($' Meta ($' Maybe Macro))) - (do Monad<Meta> - [current-module current-module-name] - (let' [[module name] ident] - (function' [state] - ("lux case" state - {{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (#Right state (find-macro' modules current-module module name))}))))) + #Nil + (-> Ident ($' Meta ($' Maybe Macro))) + (do Monad<Meta> + [current-module current-module-name] + (let' [[module name] ident] + (function' [state] + ("lux case" state + {{#info info #source source #current-module _ #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right state (find-macro' modules current-module module name))}))))) (def:''' (macro? ident) - #Nil - (-> Ident ($' Meta Bool)) - (do Monad<Meta> - [ident (normalize ident) - output (find-macro ident)] - (wrap ("lux case" output - {(#Some _) true - #None false})))) + #Nil + (-> Ident ($' Meta Bool)) + (do Monad<Meta> + [ident (normalize ident) + output (find-macro ident)] + (wrap ("lux case" output + {(#Some _) true + #None false})))) (def:''' (list/join xs) - #Nil - (All [a] - (-> ($' List ($' List a)) ($' List a))) - (list/fold list/compose #Nil (list/reverse xs))) + #Nil + (All [a] + (-> ($' List ($' List a)) ($' List a))) + (list/fold list/compose #Nil (list/reverse xs))) (def:''' (interpose sep xs) - #Nil - (All [a] - (-> a ($' List a) ($' List a))) - ("lux case" xs - {#Nil - xs + #Nil + (All [a] + (-> a ($' List a) ($' List a))) + ("lux case" xs + {#Nil + xs - (#Cons [x #Nil]) - xs + (#Cons [x #Nil]) + xs - (#Cons [x xs']) - (list& x sep (interpose sep xs'))})) + (#Cons [x xs']) + (list& x sep (interpose sep xs'))})) (def:''' (macro-expand-once token) - #Nil - (-> Code ($' Meta ($' List Code))) - ("lux case" token - {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - {(#Some macro) - (macro args) - - #None - (return (list token))})) + #Nil + (-> Code ($' Meta ($' List Code))) + ("lux case" token + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (macro args) + + #None + (return (list token))})) - _ - (return (list token))})) + _ + (return (list token))})) (def:''' (macro-expand token) - #Nil - (-> Code ($' Meta ($' List Code))) - ("lux case" token - {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - {(#Some macro) - (do Monad<Meta> - [expansion (macro args) - expansion' (monad/map Monad<Meta> macro-expand expansion)] - (wrap (list/join expansion'))) - - #None - (return (list token))})) + #Nil + (-> Code ($' Meta ($' List Code))) + ("lux case" token + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (do Monad<Meta> + [expansion (macro args) + expansion' (monad/map Monad<Meta> macro-expand expansion)] + (wrap (list/join expansion'))) + + #None + (return (list token))})) - _ - (return (list token))})) + _ + (return (list token))})) (def:''' (macro-expand-all syntax) - #Nil - (-> Code ($' Meta ($' List Code))) - ("lux case" syntax - {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - {(#Some macro) - (do Monad<Meta> - [expansion (macro args) - expansion' (monad/map Monad<Meta> macro-expand-all expansion)] - (wrap (list/join expansion'))) - - #None - (do Monad<Meta> - [args' (monad/map Monad<Meta> macro-expand-all args)] - (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))})) - - [_ (#Form members)] - (do Monad<Meta> - [members' (monad/map Monad<Meta> macro-expand-all members)] - (wrap (list (form$ (list/join members'))))) + #Nil + (-> Code ($' Meta ($' List Code))) + ("lux case" syntax + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (do Monad<Meta> + [expansion (macro args) + expansion' (monad/map Monad<Meta> macro-expand-all expansion)] + (wrap (list/join expansion'))) + + #None + (do Monad<Meta> + [args' (monad/map Monad<Meta> macro-expand-all args)] + (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))})) + + [_ (#Form members)] + (do Monad<Meta> + [members' (monad/map Monad<Meta> macro-expand-all members)] + (wrap (list (form$ (list/join members'))))) + + [_ (#Tuple members)] + (do Monad<Meta> + [members' (monad/map Monad<Meta> macro-expand-all members)] + (wrap (list (tuple$ (list/join members'))))) + + [_ (#Record pairs)] + (do Monad<Meta> + [pairs' (monad/map Monad<Meta> + (function' [kv] + (let' [[key val] kv] + (do Monad<Meta> + [val' (macro-expand-all val)] + ("lux case" val' + {(#Cons val'' #Nil) + (return [key val'']) + + _ + (fail "The value-part of a KV-pair in a record must macro-expand to a single Code.")})))) + pairs)] + (wrap (list (record$ pairs')))) - [_ (#Tuple members)] - (do Monad<Meta> - [members' (monad/map Monad<Meta> macro-expand-all members)] - (wrap (list (tuple$ (list/join members'))))) - - [_ (#Record pairs)] - (do Monad<Meta> - [pairs' (monad/map Monad<Meta> - (function' [kv] - (let' [[key val] kv] - (do Monad<Meta> - [val' (macro-expand-all val)] - ("lux case" val' - {(#;Cons val'' #;Nil) - (return [key val'']) - - _ - (fail "The value-part of a KV-pair in a record must macro-expand to a single Code.")})))) - pairs)] - (wrap (list (record$ pairs')))) - - _ - (return (list syntax))})) + _ + (return (list syntax))})) (def:''' (walk-type type) - #Nil - (-> Code Code) - ("lux case" type - {[_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (map walk-type parts)])) - - [_ (#Tuple members)] - (` (& (~@ (map walk-type members)))) - - [_ (#Form (#Cons type-fn args))] - (list/fold ("lux check" (-> Code Code Code) - (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn))))) - (walk-type type-fn) - (map walk-type args)) - - _ - type})) + #Nil + (-> Code Code) + ("lux case" type + {[_ (#Form (#Cons [_ (#Tag tag)] parts))] + (form$ (#Cons [(tag$ tag) (map walk-type parts)])) + + [_ (#Tuple members)] + (` (& (~@ (map walk-type members)))) + + [_ (#Form (#Cons type-fn args))] + (list/fold ("lux check" (-> Code Code Code) + (function' [arg type-fn] (` (#.Apply (~ arg) (~ type-fn))))) + (walk-type type-fn) + (map walk-type args)) + + _ + type})) (macro:' #export (type tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Takes a type expression and returns it's representation as data-structure. - (type (All [a] (Maybe (List a))))")]) - ("lux case" tokens - {(#Cons type #Nil) - (do Monad<Meta> - [type+ (macro-expand-all type)] - ("lux case" type+ - {(#Cons type' #Nil) - (wrap (list (walk-type type'))) - - _ - (fail "The expansion of the type-syntax had to yield a single element.")})) + (list [(tag$ ["lux" "doc"]) + (text$ "## Takes a type expression and returns it's representation as data-structure. + (type (All [a] (Maybe (List a))))")]) + ("lux case" tokens + {(#Cons type #Nil) + (do Monad<Meta> + [type+ (macro-expand-all type)] + ("lux case" type+ + {(#Cons type' #Nil) + (wrap (list (walk-type type'))) + + _ + (fail "The expansion of the type-syntax had to yield a single element.")})) - _ - (fail "Wrong syntax for type")})) + _ + (fail "Wrong syntax for type")})) (macro:' #export (: tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## The type-annotation macro. - (: (List Int) (list 1 2 3))")]) - ("lux case" tokens - {(#Cons type (#Cons value #Nil)) - (return (list (` ("lux check" (type (~ type)) (~ value))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## The type-annotation macro. + (: (List Int) (list 1 2 3))")]) + ("lux case" tokens + {(#Cons type (#Cons value #Nil)) + (return (list (` ("lux check" (type (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :")})) + _ + (fail "Wrong syntax for :")})) (macro:' #export (:! tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## The type-coercion macro. - (:! Dinosaur (list 1 2 3))")]) - ("lux case" tokens - {(#Cons type (#Cons value #Nil)) - (return (list (` ("lux coerce" (type (~ type)) (~ value))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## The type-coercion macro. + (:! Dinosaur (list 1 2 3))")]) + ("lux case" tokens + {(#Cons type (#Cons value #Nil)) + (return (list (` ("lux coerce" (type (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :!")})) + _ + (fail "Wrong syntax for :!")})) (def:''' (empty? xs) - #Nil - (All [a] (-> ($' List a) Bool)) - ("lux case" xs - {#Nil true - _ false})) + #Nil + (All [a] (-> ($' List a) Bool)) + ("lux case" xs + {#Nil true + _ false})) (do-template [<name> <type> <value>] [(def:''' (<name> xy) - #Nil - (All [a b] (-> (& a b) <type>)) - (let' [[x y] xy] <value>))] + #Nil + (All [a b] (-> (& a b) <type>)) + (let' [[x y] xy] <value>))] [first a x] [second b y]) (def:''' (unfold-type-def type-codes) - #Nil - (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) - ("lux case" type-codes - {(#Cons [_ (#Record pairs)] #;Nil) - (do Monad<Meta> - [members (monad/map Monad<Meta> - (: (-> [Code Code] (Meta [Text Code])) - (function' [pair] - ("lux case" pair - {[[_ (#Tag "" member-name)] member-type] - (return [member-name member-type]) - - _ - (fail "Wrong syntax for variant case.")}))) - pairs)] - (return [(` (& (~@ (map second members)))) - (#Some (map first members))])) - - (#Cons type #Nil) - ("lux case" type - {[_ (#Tag "" member-name)] - (return [(` #;Unit) (#;Some (list member-name))]) - - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [(` (& (~@ member-types))) (#;Some (list member-name))]) - - _ - (return [type #None])}) - - (#Cons case cases) - (do Monad<Meta> - [members (monad/map Monad<Meta> - (: (-> Code (Meta [Text Code])) - (function' [case] - ("lux case" case - {[_ (#Tag "" member-name)] - (return [member-name (` Unit)]) - - [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))] - (return [member-name member-type]) - - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [member-name (` (& (~@ member-types)))]) + #Nil + (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) + ("lux case" type-codes + {(#Cons [_ (#Record pairs)] #Nil) + (do Monad<Meta> + [members (monad/map Monad<Meta> + (: (-> [Code Code] (Meta [Text Code])) + (function' [pair] + ("lux case" pair + {[[_ (#Tag "" member-name)] member-type] + (return [member-name member-type]) + + _ + (fail "Wrong syntax for variant case.")}))) + pairs)] + (return [(` (& (~@ (map second members)))) + (#Some (map first members))])) + + (#Cons type #Nil) + ("lux case" type + {[_ (#Tag "" member-name)] + (return [(` #.Unit) (#Some (list member-name))]) + + [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] + (return [(` (& (~@ member-types))) (#Some (list member-name))]) - _ - (fail "Wrong syntax for variant case.")}))) - (list& case cases))] - (return [(` (| (~@ (map second members)))) - (#Some (map first members))])) + _ + (return [type #None])}) + + (#Cons case cases) + (do Monad<Meta> + [members (monad/map Monad<Meta> + (: (-> Code (Meta [Text Code])) + (function' [case] + ("lux case" case + {[_ (#Tag "" member-name)] + (return [member-name (` Unit)]) + + [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))] + (return [member-name member-type]) + + [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] + (return [member-name (` (& (~@ member-types)))]) + + _ + (fail "Wrong syntax for variant case.")}))) + (list& case cases))] + (return [(` (| (~@ (map second members)))) + (#Some (map first members))])) - _ - (fail "Improper type-definition syntax")})) + _ + (fail "Improper type-definition syntax")})) (def:''' (gensym prefix state) - #Nil - (-> Text ($' Meta Code)) - ("lux case" state - {{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (#Right {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host - #seed (n/+ +1 seed) #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))})) + #Nil + (-> Text ($' Meta Code)) + ("lux case" state + {{#info info #source source #current-module _ #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right {#info info #source source #current-module _ #modules modules + #scopes scopes #type-context types #host host + #seed (n/+ +1 seed) #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))})) (macro:' #export (Rec tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Parameter-less recursive types. - ## A name has to be given to the whole type, to use it within its body. - (Rec Self - [Int (List Self)])")]) - ("lux case" tokens - {(#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) - (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))]) - (update-bounds body))] - (return (list (` (#Apply #;Void (#UnivQ #Nil (~ body'))))))) - - _ - (fail "Wrong syntax for Rec")})) + (list [(tag$ ["lux" "doc"]) + (text$ "## Parameter-less recursive types. + ## A name has to be given to the whole type, to use it within its body. + (Rec Self + [Int (List Self)])")]) + ("lux case" tokens + {(#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) + (let' [body' (replace-syntax (list [name (` (#.Apply (~ (make-bound +1)) (~ (make-bound +0))))]) + (update-bounds body))] + (return (list (` (#.Apply #.Void (#.UnivQ #.Nil (~ body'))))))) + + _ + (fail "Wrong syntax for Rec")})) (macro:' #export (exec tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Sequential execution of expressions (great for side-effects). - (exec - (log! \"#1\") - (log! \"#2\") - (log! \"#3\") - \"YOLO\")")]) - ("lux case" (list/reverse tokens) - {(#Cons value actions) - (let' [dummy (symbol$ ["" ""])] - (return (list (list/fold ("lux check" (-> Code Code Code) - (function' [pre post] (` ("lux case" (~ pre) {(~ dummy) (~ post)})))) - value - actions)))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Sequential execution of expressions (great for side-effects). + (exec + (log! \"#1\") + (log! \"#2\") + (log! \"#3\") + \"YOLO\")")]) + ("lux case" (list/reverse tokens) + {(#Cons value actions) + (let' [dummy (symbol$ ["" ""])] + (return (list (list/fold ("lux check" (-> Code Code Code) + (function' [pre post] (` ("lux case" (~ pre) {(~ dummy) (~ post)})))) + value + actions)))) - _ - (fail "Wrong syntax for exec")})) + _ + (fail "Wrong syntax for exec")})) (macro:' (def:' tokens) - (let' [[export? tokens'] ("lux case" tokens - {(#Cons [_ (#Tag ["" "export"])] tokens') - [true tokens'] - - _ - [false tokens]}) - parts (: (Maybe [Code (List Code) (Maybe Code) Code]) - ("lux case" tokens' - {(#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil))) - (#Some name args (#Some type) body) - - (#Cons name (#Cons type (#Cons body #Nil))) - (#Some name #Nil (#Some type) body) - - (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (#Some name args #None body) - - (#Cons name (#Cons body #Nil)) - (#Some name #Nil #None body) + (let' [[export? tokens'] ("lux case" tokens + {(#Cons [_ (#Tag ["" "export"])] tokens') + [true tokens'] + + _ + [false tokens]}) + parts (: (Maybe [Code (List Code) (Maybe Code) Code]) + ("lux case" tokens' + {(#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil))) + (#Some name args (#Some type) body) + + (#Cons name (#Cons type (#Cons body #Nil))) + (#Some name #Nil (#Some type) body) + + (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (#Some name args #None body) + + (#Cons name (#Cons body #Nil)) + (#Some name #Nil #None body) - _ - #None}))] - ("lux case" parts - {(#Some name args ?type body) - (let' [body' ("lux case" args - {#Nil - body + _ + #None}))] + ("lux case" parts + {(#Some name args ?type body) + (let' [body' ("lux case" args + {#Nil + body - _ - (` (function' (~ name) [(~@ args)] (~ body)))}) - body'' ("lux case" ?type - {(#Some type) - (` (: (~ type) (~ body'))) - - #None - body'})] - (return (list (` ("lux def" (~ name) (~ body'') - [(~ cursor-code) - (#;Record (~ (if export? - (with-export-meta (tag$ ["lux" "Nil"])) - (tag$ ["lux" "Nil"]))))]))))) - - #None - (fail "Wrong syntax for def'")}))) + _ + (` (function' (~ name) [(~@ args)] (~ body)))}) + body'' ("lux case" ?type + {(#Some type) + (` (: (~ type) (~ body'))) + + #None + body'})] + (return (list (` ("lux def" (~ name) (~ body'') + [(~ cursor-code) + (#.Record (~ (if export? + (with-export-meta (tag$ ["lux" "Nil"])) + (tag$ ["lux" "Nil"]))))]))))) + + #None + (fail "Wrong syntax for def'")}))) (def:' (rejoin-pair pair) - (-> [Code Code] (List Code)) - (let' [[left right] pair] - (list left right))) + (-> [Code Code] (List Code)) + (let' [[left right] pair] + (list left right))) (def:' (code-to-text code) - (-> Code Text) - ("lux case" code - {[_ (#Bool value)] - (bool/encode value) - - [_ (#Nat value)] - (nat/encode value) - - [_ (#Int value)] - (int/encode value) - - [_ (#Deg value)] - ("lux io error" "Undefined behavior.") - - [_ (#Frac value)] - (frac/encode value) - - [_ (#Text value)] - ($_ text/compose "\"" value "\"") - - [_ (#Symbol [prefix name])] - (if (text/= "" prefix) - name - ($_ text/compose prefix ";" name)) - - [_ (#Tag [prefix name])] - (if (text/= "" prefix) - ($_ text/compose "#" name) - ($_ text/compose "#" prefix ";" name)) - - [_ (#Form xs)] - ($_ text/compose "(" (|> xs - (map code-to-text) - (interpose " ") - list/reverse - (list/fold text/compose "")) ")") - - [_ (#Tuple xs)] - ($_ text/compose "[" (|> xs - (map code-to-text) - (interpose " ") - list/reverse - (list/fold text/compose "")) "]") - - [_ (#Record kvs)] - ($_ text/compose "{" (|> kvs - (map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))}))) - (interpose " ") - list/reverse - (list/fold text/compose "")) "}")} - )) + (-> Code Text) + ("lux case" code + {[_ (#Bool value)] + (bool/encode value) + + [_ (#Nat value)] + (nat/encode value) + + [_ (#Int value)] + (int/encode value) + + [_ (#Deg value)] + ("lux io error" "Undefined behavior.") + + [_ (#Frac value)] + (frac/encode value) + + [_ (#Text value)] + ($_ text/compose "\"" value "\"") + + [_ (#Symbol [prefix name])] + (if (text/= "" prefix) + name + ($_ text/compose prefix "." name)) + + [_ (#Tag [prefix name])] + (if (text/= "" prefix) + ($_ text/compose "#" name) + ($_ text/compose "#" prefix "." name)) + + [_ (#Form xs)] + ($_ text/compose "(" (|> xs + (map code-to-text) + (interpose " ") + list/reverse + (list/fold text/compose "")) ")") + + [_ (#Tuple xs)] + ($_ text/compose "[" (|> xs + (map code-to-text) + (interpose " ") + list/reverse + (list/fold text/compose "")) "]") + + [_ (#Record kvs)] + ($_ text/compose "{" (|> kvs + (map (function' [kv] ("lux case" kv {[k v] ($_ text/compose (code-to-text k) " " (code-to-text v))}))) + (interpose " ") + list/reverse + (list/fold text/compose "")) "}")} + )) (def:' (expander branches) - (-> (List Code) (Meta (List Code))) - ("lux case" branches - {(#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] - (#;Cons body - branches')) - (do Monad<Meta> - [??? (macro? macro-name)] - (if ??? - (do Monad<Meta> - [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] - (expander init-expansion)) - (do Monad<Meta> - [sub-expansion (expander branches')] - (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) - body - sub-expansion))))) + (-> (List Code) (Meta (List Code))) + ("lux case" branches + {(#Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] + (#Cons body + branches')) + (do Monad<Meta> + [??? (macro? macro-name)] + (if ??? + (do Monad<Meta> + [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] + (expander init-expansion)) + (do Monad<Meta> + [sub-expansion (expander branches')] + (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) + body + sub-expansion))))) - (#;Cons pattern (#;Cons body branches')) - (do Monad<Meta> - [sub-expansion (expander branches')] - (wrap (list& pattern body sub-expansion))) + (#Cons pattern (#Cons body branches')) + (do Monad<Meta> + [sub-expansion (expander branches')] + (wrap (list& pattern body sub-expansion))) - #;Nil - (do Monad<Meta> [] (wrap (list))) + #Nil + (do Monad<Meta> [] (wrap (list))) - _ - (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches - (map code-to-text) - (interpose " ") - list/reverse - (list/fold text/compose ""))))})) + _ + (fail ($_ text/compose "\"lux.case\" expects an even number of tokens: " (|> branches + (map code-to-text) + (interpose " ") + list/reverse + (list/fold text/compose ""))))})) (macro:' #export (case tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## The pattern-matching macro. - ## Allows the usage of macros within the patterns to provide custom syntax. - (case (: (List Int) (list 1 2 3)) - (#Cons x (#Cons y (#Cons z #Nil))) - (#Some ($_ i/* x y z)) + (list [(tag$ ["lux" "doc"]) + (text$ "## The pattern-matching macro. + ## Allows the usage of macros within the patterns to provide custom syntax. + (case (: (List Int) (list 1 2 3)) + (#Cons x (#Cons y (#Cons z #Nil))) + (#Some ($_ i/* x y z)) - _ - #None)")]) - ("lux case" tokens - {(#Cons value branches) - (do Monad<Meta> - [expansion (expander branches)] - (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion)))))))) + _ + #None)")]) + ("lux case" tokens + {(#Cons value branches) + (do Monad<Meta> + [expansion (expander branches)] + (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion)))))))) - _ - (fail "Wrong syntax for case")})) + _ + (fail "Wrong syntax for case")})) (macro:' #export (^ tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Macro-expanding patterns. - ## It's a special macro meant to be used with 'case'. - (case (: (List Int) (list 1 2 3)) - (^ (list x y z)) - (#Some ($_ i/* x y z)) + (list [(tag$ ["lux" "doc"]) + (text$ "## Macro-expanding patterns. + ## It's a special macro meant to be used with 'case'. + (case (: (List Int) (list 1 2 3)) + (^ (list x y z)) + (#Some ($_ i/* x y z)) - _ - #None)")]) - (case tokens - (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) - (do Monad<Meta> - [pattern+ (macro-expand-all pattern)] - (case pattern+ - (#Cons pattern' #Nil) - (wrap (list& pattern' body branches)) - - _ - (fail "^ can only expand to 1 pattern."))) - - _ - (fail "Wrong syntax for ^ macro"))) + _ + #None)")]) + (case tokens + (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) + (do Monad<Meta> + [pattern+ (macro-expand-all pattern)] + (case pattern+ + (#Cons pattern' #Nil) + (wrap (list& pattern' body branches)) + + _ + (fail "^ can only expand to 1 pattern."))) + + _ + (fail "Wrong syntax for ^ macro"))) (macro:' #export (^or tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Or-patterns. - ## It's a special macro meant to be used with 'case'. - (type: Weekday - #Monday - #Tuesday - #Wednesday - #Thursday - #Friday - #Saturday - #Sunday) - - (def: (weekend? day) - (-> Weekday Bool) - (case day - (^or #Saturday #Sunday) - true - - _ - false))")]) - (case tokens - (^ (list& [_ (#Form patterns)] body branches)) - (case patterns - #Nil - (fail "^or cannot have 0 patterns") + (list [(tag$ ["lux" "doc"]) + (text$ "## Or-patterns. + ## It's a special macro meant to be used with 'case'. + (type: Weekday + #Monday + #Tuesday + #Wednesday + #Thursday + #Friday + #Saturday + #Sunday) + + (def: (weekend? day) + (-> Weekday Bool) + (case day + (^or #Saturday #Sunday) + true + + _ + false))")]) + (case tokens + (^ (list& [_ (#Form patterns)] body branches)) + (case patterns + #Nil + (fail "^or cannot have 0 patterns") - _ - (let' [pairs (|> patterns - (map (function' [pattern] (list pattern body))) - (list/join))] - (return (list/compose pairs branches)))) - _ - (fail "Wrong syntax for ^or"))) + _ + (let' [pairs (|> patterns + (map (function' [pattern] (list pattern body))) + (list/join))] + (return (list/compose pairs branches)))) + _ + (fail "Wrong syntax for ^or"))) (def:' (symbol? code) - (-> Code Bool) - (case code - [_ (#Symbol _)] - true + (-> Code Bool) + (case code + [_ (#Symbol _)] + true - _ - false)) + _ + false)) (macro:' #export (let tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Creates local bindings. - ## Can (optionally) use pattern-matching macros when binding. - (let [x (foo bar) - y (baz quux)] - (op x y))")]) - (case tokens - (^ (list [_ (#Tuple bindings)] body)) - (if (multiple? +2 (list/size bindings)) - (|> bindings as-pairs list/reverse - (list/fold (: (-> [Code Code] Code Code) - (function' [lr body'] - (let' [[l r] lr] - (if (symbol? l) - (` ("lux case" (~ r) {(~ l) (~ body')})) - (` (case (~ r) (~ l) (~ body'))))))) - body) - list - return) - (fail "let requires an even number of parts")) + (list [(tag$ ["lux" "doc"]) + (text$ "## Creates local bindings. + ## Can (optionally) use pattern-matching macros when binding. + (let [x (foo bar) + y (baz quux)] + (op x y))")]) + (case tokens + (^ (list [_ (#Tuple bindings)] body)) + (if (multiple? +2 (list/size bindings)) + (|> bindings as-pairs list/reverse + (list/fold (: (-> [Code Code] Code Code) + (function' [lr body'] + (let' [[l r] lr] + (if (symbol? l) + (` ("lux case" (~ r) {(~ l) (~ body')})) + (` (case (~ r) (~ l) (~ body'))))))) + body) + list + return) + (fail "let requires an even number of parts")) - _ - (fail "Wrong syntax for let"))) + _ + (fail "Wrong syntax for let"))) (macro:' #export (function tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Syntax for creating functions. - ## Allows for giving the function itself a name, for the sake of recursion. - (: (All [a b] (-> a b a)) - (function [x y] x)) - - (: (All [a b] (-> a b a)) - (function const [x y] x))")]) - (case (: (Maybe [Ident Code (List Code) Code]) - (case tokens - (^ (list [_ (#Tuple (#Cons head tail))] body)) - (#Some ["" ""] head tail body) - - (^ (list [_ (#Symbol ["" name])] [_ (#Tuple (#Cons head tail))] body)) - (#Some ["" name] head tail body) - - _ - #None)) - (#Some ident head tail body) - (let [g!blank (symbol$ ["" ""]) - g!name (symbol$ ident) - body+ (list/fold (: (-> Code Code Code) - (function' [arg body'] - (if (symbol? arg) - (` ("lux function" (~ g!blank) (~ arg) (~ body'))) - (` ("lux function" (~ g!blank) (~ g!blank) - (case (~ g!blank) (~ arg) (~ body'))))))) - body - (list/reverse tail))] - (return (list (if (symbol? head) - (` ("lux function" (~ g!name) (~ head) (~ body+))) - (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) - - #None - (fail "Wrong syntax for function"))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Syntax for creating functions. + ## Allows for giving the function itself a name, for the sake of recursion. + (: (All [a b] (-> a b a)) + (function [x y] x)) + + (: (All [a b] (-> a b a)) + (function const [x y] x))")]) + (case (: (Maybe [Ident Code (List Code) Code]) + (case tokens + (^ (list [_ (#Tuple (#Cons head tail))] body)) + (#Some ["" ""] head tail body) + + (^ (list [_ (#Symbol ["" name])] [_ (#Tuple (#Cons head tail))] body)) + (#Some ["" name] head tail body) + + _ + #None)) + (#Some ident head tail body) + (let [g!blank (symbol$ ["" ""]) + g!name (symbol$ ident) + body+ (list/fold (: (-> Code Code Code) + (function' [arg body'] + (if (symbol? arg) + (` ("lux function" (~ g!blank) (~ arg) (~ body'))) + (` ("lux function" (~ g!blank) (~ g!blank) + (case (~ g!blank) (~ arg) (~ body'))))))) + body + (list/reverse tail))] + (return (list (if (symbol? head) + (` ("lux function" (~ g!name) (~ head) (~ body+))) + (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) + + #None + (fail "Wrong syntax for function"))) (def:' (process-def-meta-value code) - (-> Code Code) - (case code - [_ (#Bool value)] - (meta-code ["lux" "Bool"] (bool$ value)) - - [_ (#Nat value)] - (meta-code ["lux" "Nat"] (nat$ value)) - - [_ (#Int value)] - (meta-code ["lux" "Int"] (int$ value)) - - [_ (#Deg value)] - (meta-code ["lux" "Deg"] (deg$ value)) - - [_ (#Frac value)] - (meta-code ["lux" "Frac"] (frac$ value)) - - [_ (#Text value)] - (meta-code ["lux" "Text"] (text$ value)) - - [_ (#Tag [prefix name])] - (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) - - (^or [_ (#Form _)] [_ (#Symbol _)]) - code - - [_ (#Tuple xs)] - (|> xs - (map process-def-meta-value) - untemplate-list - (meta-code ["lux" "Tuple"])) - - [_ (#Record kvs)] - (|> kvs - (map (: (-> [Code Code] Code) - (function [[k v]] - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))])))) - untemplate-list - (meta-code ["lux" "Record"])) - )) + (-> Code Code) + (case code + [_ (#Bool value)] + (meta-code ["lux" "Bool"] (bool$ value)) + + [_ (#Nat value)] + (meta-code ["lux" "Nat"] (nat$ value)) + + [_ (#Int value)] + (meta-code ["lux" "Int"] (int$ value)) + + [_ (#Deg value)] + (meta-code ["lux" "Deg"] (deg$ value)) + + [_ (#Frac value)] + (meta-code ["lux" "Frac"] (frac$ value)) + + [_ (#Text value)] + (meta-code ["lux" "Text"] (text$ value)) + + [_ (#Tag [prefix name])] + (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) + + (^or [_ (#Form _)] [_ (#Symbol _)]) + code + + [_ (#Tuple xs)] + (|> xs + (map process-def-meta-value) + untemplate-list + (meta-code ["lux" "Tuple"])) + + [_ (#Record kvs)] + (|> kvs + (map (: (-> [Code Code] Code) + (function [[k v]] + (` [(~ (process-def-meta-value k)) + (~ (process-def-meta-value v))])))) + untemplate-list + (meta-code ["lux" "Record"])) + )) (def:' (process-def-meta kvs) - (-> (List [Code Code]) Code) - (untemplate-list (map (: (-> [Code Code] Code) - (function [[k v]] - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))]))) - kvs))) + (-> (List [Code Code]) Code) + (untemplate-list (map (: (-> [Code Code] Code) + (function [[k v]] + (` [(~ (process-def-meta-value k)) + (~ (process-def-meta-value v))]))) + kvs))) (def:' (with-func-args args meta) - (-> (List Code) Code Code) - (case args - #;Nil - meta - - _ - (` (#;Cons [[(~ cursor-code) (#;Tag ["lux" "func-args"])] - [(~ cursor-code) (#;Tuple (;list (~@ (map (function [arg] - (` [(~ cursor-code) (#;Text (~ (text$ (code-to-text arg))))])) - args))))]] - (~ meta))))) + (-> (List Code) Code Code) + (case args + #Nil + meta + + _ + (` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])] + [(~ cursor-code) (#.Tuple (.list (~@ (map (function [arg] + (` [(~ cursor-code) (#.Text (~ (text$ (code-to-text arg))))])) + args))))]] + (~ meta))))) (def:' (with-type-args args) - (-> (List Code) Code) - (` {#;type-args [(~@ (map (function [arg] (text$ (code-to-text arg))) - args))]})) + (-> (List Code) Code) + (` {#.type-args [(~@ (map (function [arg] (text$ (code-to-text arg))) + args))]})) (def:' Export-Level - Type - ($' Either - Unit ## Exported - Unit ## Hidden - )) + Type + ($' Either + Unit ## Exported + Unit ## Hidden + )) (def:' (export-level^ tokens) - (-> (List Code) [(Maybe Export-Level) (List Code)]) - (case tokens - (#Cons [_ (#Tag [_ "export"])] tokens') - [(#;Some (#;Left [])) tokens'] + (-> (List Code) [(Maybe Export-Level) (List Code)]) + (case tokens + (#Cons [_ (#Tag [_ "export"])] tokens') + [(#Some (#Left [])) tokens'] - (#Cons [_ (#Tag [_ "hidden"])] tokens') - [(#;Some (#;Right [])) tokens'] + (#Cons [_ (#Tag [_ "hidden"])] tokens') + [(#Some (#Right [])) tokens'] - _ - [#;None tokens])) + _ + [#None tokens])) (def:' (export-level ?el) - (-> (Maybe Export-Level) (List Code)) - (case ?el - #;None - (list) + (-> (Maybe Export-Level) (List Code)) + (case ?el + #None + (list) - (#;Some (#;Left [])) - (list (' #export)) + (#Some (#Left [])) + (list (' #export)) - (#;Some (#;Right [])) - (list (' #hidden)))) + (#Some (#Right [])) + (list (' #hidden)))) (macro:' #export (def: tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Defines global constants/functions. - (def: (rejoin-pair pair) - (-> [Code Code] (List Code)) - (let [[left right] pair] - (list left right))) - - (def: branching-exponent - Int - 5)")]) - (let [[export? tokens'] (export-level^ tokens) - parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) - (case tokens' - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) - (#Some [name args (#Some type) body meta-kvs]) - - (^ (list name [_ (#Record meta-kvs)] type body)) - (#Some [name #Nil (#Some type) body meta-kvs]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Defines global constants/functions. + (def: (rejoin-pair pair) + (-> [Code Code] (List Code)) + (let [[left right] pair] + (list left right))) + + (def: branching-exponent + Int + 5)")]) + (let [[export? tokens'] (export-level^ tokens) + parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) + (case tokens' + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) + (#Some [name args (#Some type) body meta-kvs]) + + (^ (list name [_ (#Record meta-kvs)] type body)) + (#Some [name #Nil (#Some type) body meta-kvs]) - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body)) - (#Some [name args #None body meta-kvs]) + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body)) + (#Some [name args #None body meta-kvs]) - (^ (list name [_ (#Record meta-kvs)] body)) - (#Some [name #Nil #None body meta-kvs]) - - (^ (list [_ (#Form (#Cons name args))] type body)) - (#Some [name args (#Some type) body #Nil]) - - (^ (list name type body)) - (#Some [name #Nil (#Some type) body #Nil]) - - (^ (list [_ (#Form (#Cons name args))] body)) - (#Some [name args #None body #Nil]) - - (^ (list name body)) - (#Some [name #Nil #None body #Nil]) + (^ (list name [_ (#Record meta-kvs)] body)) + (#Some [name #Nil #None body meta-kvs]) + + (^ (list [_ (#Form (#Cons name args))] type body)) + (#Some [name args (#Some type) body #Nil]) + + (^ (list name type body)) + (#Some [name #Nil (#Some type) body #Nil]) + + (^ (list [_ (#Form (#Cons name args))] body)) + (#Some [name args #None body #Nil]) + + (^ (list name body)) + (#Some [name #Nil #None body #Nil]) - _ - #None))] - (case parts - (#Some name args ?type body meta) - (let [body (case args - #Nil - body + _ + #None))] + (case parts + (#Some name args ?type body meta) + (let [body (case args + #Nil + body - _ - (` (function (~ name) [(~@ args)] (~ body)))) - body (case ?type - (#Some type) - (` (: (~ type) (~ body))) - - #None - body) - =meta (process-def-meta meta)] - (return (list (` ("lux def" (~ name) - (~ body) - [(~ cursor-code) - (#;Record (~ (with-func-args args - (case export? - #;None - =meta - - (#;Some (#;Left [])) - (with-export-meta =meta) - - (#;Some (#;Right [])) - (|> =meta - with-export-meta - with-hidden-meta) - ))))]))))) - - #None - (fail "Wrong syntax for def:")))) + _ + (` (function (~ name) [(~@ args)] (~ body)))) + body (case ?type + (#Some type) + (` (: (~ type) (~ body))) + + #None + body) + =meta (process-def-meta meta)] + (return (list (` ("lux def" (~ name) + (~ body) + [(~ cursor-code) + (#Record (~ (with-func-args args + (case export? + #None + =meta + + (#Some (#Left [])) + (with-export-meta =meta) + + (#Some (#Right [])) + (|> =meta + with-export-meta + with-hidden-meta) + ))))]))))) + + #None + (fail "Wrong syntax for def:")))) (def: (meta-code-add addition meta) (-> [Code Code] Code Code) (case [addition meta] - [[name value] [cursor (#;Record pairs)]] - [cursor (#;Record (#;Cons [name value] pairs))] + [[name value] [cursor (#Record pairs)]] + [cursor (#Record (#Cons [name value] pairs))] _ meta)) @@ -3230,62 +3238,62 @@ (def: (meta-code-merge addition base) (-> Code Code Code) (case addition - [cursor (#;Record pairs)] + [cursor (#Record pairs)] (list/fold meta-code-add base pairs) _ base)) (macro:' #export (macro: tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "Macro-definition macro. + (list [(tag$ ["lux" "doc"]) + (text$ "Macro-definition macro. + + (macro: #export (ident-for tokens) + (case tokens + (^template [<tag>] + (^ (list [_ (<tag> [prefix name])])) + (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) + ([#Symbol] [#Tag]) + + _ + (fail \"Wrong syntax for ident-for\")))")]) + (let [[exported? tokens] (export-level^ tokens) + name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) + (case tokens + (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] body)) + (#Some [name args (` {}) body]) + + (^ (list [_ (#Symbol name)] body)) + (#Some [name #Nil (` {}) body]) - (macro: #export (ident-for tokens) - (case tokens - (^template [<tag>] - (^ (list [_ (<tag> [prefix name])])) - (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) - ([#;Symbol] [#;Tag]) + (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] body)) + (#Some [name args [meta-rec-cursor (#Record meta-rec-parts)] body]) + + (^ (list [_ (#Symbol name)] [meta-rec-cursor (#Record meta-rec-parts)] body)) + (#Some [name #Nil [meta-rec-cursor (#Record meta-rec-parts)] body]) - _ - (fail \"Wrong syntax for ident-for\")))")]) - (let [[exported? tokens] (export-level^ tokens) - name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) - (case tokens - (^ (list [_ (#;Form (list& [_ (#Symbol name)] args))] body)) - (#Some [name args (` {}) body]) - - (^ (list [_ (#;Symbol name)] body)) - (#Some [name #Nil (` {}) body]) - - (^ (list [_ (#;Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#;Record meta-rec-parts)] body)) - (#Some [name args [meta-rec-cursor (#;Record meta-rec-parts)] body]) - - (^ (list [_ (#;Symbol name)] [meta-rec-cursor (#;Record meta-rec-parts)] body)) - (#Some [name #Nil [meta-rec-cursor (#;Record meta-rec-parts)] body]) - - _ - #None))] - (case name+args+meta+body?? - (#Some [name args meta body]) - (let [name (symbol$ name) - def-sig (case args - #;Nil name - _ (` ((~ name) (~@ args))))] - (return (list (` (;;def: (~@ (export-level exported?)) - (~ def-sig) - (~ (meta-code-merge (` {#;macro? true}) - meta)) - - ;;Macro - (~ body)))))) - + _ + #None))] + (case name+args+meta+body?? + (#Some [name args meta body]) + (let [name (symbol$ name) + def-sig (case args + #Nil name + _ (` ((~ name) (~@ args))))] + (return (list (` (..def: (~@ (export-level exported?)) + (~ def-sig) + (~ (meta-code-merge (` {#.macro? true}) + meta)) + + ..Macro + (~ body)))))) + - #None - (fail "Wrong syntax for macro:")))) + #None + (fail "Wrong syntax for macro:")))) (macro: #export (sig: tokens) - {#;doc "## Definition of signatures ala ML. + {#.doc "## Definition of signatures ala ML. (sig: #export (Ord a) (: (Eq a) eq) @@ -3300,11 +3308,11 @@ (let [[exported? tokens'] (export-level^ tokens) ?parts (: (Maybe [Ident (List Code) Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#;Record meta-rec-parts)] sigs)) - (#Some name args [meta-rec-cursor (#;Record meta-rec-parts)] sigs) + (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) + (#Some name args [meta-rec-cursor (#Record meta-rec-parts)] sigs) - (^ (list& [_ (#Symbol name)] [meta-rec-cursor (#;Record meta-rec-parts)] sigs)) - (#Some name #Nil [meta-rec-cursor (#;Record meta-rec-parts)] sigs) + (^ (list& [_ (#Symbol name)] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) + (#Some name #Nil [meta-rec-cursor (#Record meta-rec-parts)] sigs) (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] sigs)) (#Some name args (` {}) sigs) @@ -3336,15 +3344,15 @@ (function [[m-name m-type]] [(tag$ ["" m-name]) m-type])) members)) - sig-meta (meta-code-merge (` {#;sig? true}) + sig-meta (meta-code-merge (` {#.sig? true}) meta) usage (case args - #;Nil + #Nil def-name _ (` ((~ def-name) (~@ args))))]] - (return (list (` (;;type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) + (return (list (` (..type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) #None (fail "Wrong syntax for sig:")))) @@ -3366,7 +3374,7 @@ (do-template [<name> <form> <message> <doc-msg>] [(macro: #export (<name> tokens) - {#;doc <doc-msg>} + {#.doc <doc-msg>} (case (list/reverse tokens) (^ (list& last init)) (return (list (list/fold (: (-> Code Code Code) @@ -3387,20 +3395,20 @@ (def: (last-index-of' part part-size since text) (-> Text Nat Nat Text (Maybe Nat)) (case ("lux text index" text part (n/+ part-size since)) - #;None - (#;Some since) + #None + (#Some since) - (#;Some since') + (#Some since') (last-index-of' part part-size since' text))) (def: (last-index-of part text) (-> Text Text (Maybe Nat)) (case ("lux text index" text part +0) - (#;Some since) + (#Some since) (last-index-of' part ("lux text size" part) since text) - #;None - #;None)) + #None + #None)) (def: (clip1 from text) (-> Nat Text (Maybe Text)) @@ -3411,38 +3419,38 @@ ("lux text clip" text from to)) (def: #export (error! message) - {#;doc "## Causes an error, with the given error message. + {#.doc "## Causes an error, with the given error message. (error! \"OH NO!\")"} (-> Text Bottom) ("lux io error" message)) (macro: (default tokens state) - {#;doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #;None. - (default 20 (#;Some 10)) => 10 + {#.doc "## Allows you to provide a default value that will be used + ## if a (Maybe x) value turns out to be #.None. + (default 20 (#.Some 10)) => 10 - (default 20 #;None) => 20"} + (default 20 #.None) => 20"} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-cursor (#;Symbol ["" ""])]) + (let [g!temp (: Code [dummy-cursor (#Symbol ["" ""])]) code (` (case (~ maybe) - (#;Some (~ g!temp)) + (#.Some (~ g!temp)) (~ g!temp) - #;None + #.None (~ else)))] - (#;Right [state (list code)])) + (#Right [state (list code)])) _ - (#;Left "Wrong syntax for default"))) + (#Left "Wrong syntax for default"))) (def: (text/split splitter input) (-> Text Text (List Text)) (case (index-of splitter input) - #;None + #None (list input) - (#;Some idx) + (#Some idx) (list& (default (error! "UNDEFINED") (clip2 +0 idx input)) (text/split splitter @@ -3538,17 +3546,17 @@ _ (list type)))] - [flatten-variant #;Sum] - [flatten-tuple #;Product] - [flatten-lambda #;Function] + [flatten-variant #Sum] + [flatten-tuple #Product] + [flatten-lambda #Function] ) (def: (flatten-app type) (-> Type [Type (List Type)]) (case type - (#;Apply head func') + (#Apply head func') (let [[func tail] (flatten-app func')] - [func (#;Cons head tail)]) + [func (#Cons head tail)]) _ [type (list)])) @@ -3657,7 +3665,7 @@ (#Left "Not expecting any type."))))) (macro: #export (struct tokens) - {#;doc "Not meant to be used directly. Prefer \"struct:\"."} + {#.doc "Not meant to be used directly. Prefer \"struct:\"."} (do Monad<Meta> [tokens' (monad/map Monad<Meta> macro-expand tokens) struct-type get-expected-type @@ -3694,27 +3702,27 @@ (|> parts list/reverse (list/fold text/compose ""))) (macro: #export (struct: tokens) - {#;doc "## Definition of structures ala ML. + {#.doc "## Definition of structures ala ML. (struct: #export Ord<Int> (Ord Int) (def: eq Eq<Int>) (def: (< test subject) - (lux;< test subject)) + (lux.< test subject)) (def: (<= test subject) - (or (lux;< test subject) - (lux;= test subject))) - (def: (lux;> test subject) - (lux;> test subject)) - (def: (lux;>= test subject) - (or (lux;> test subject) - (lux;= test subject))))"} + (or (lux.< test subject) + (lux.= test subject))) + (def: (lux.> test subject) + (lux.> test subject)) + (def: (lux.>= test subject) + (or (lux.> test subject) + (lux.= test subject))))"} (let [[exported? tokens'] (export-level^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#;Record meta-rec-parts)] type defs)) - (#Some name args type [meta-rec-cursor (#;Record meta-rec-parts)] defs) + (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#Record meta-rec-parts)] type defs)) + (#Some name args type [meta-rec-cursor (#Record meta-rec-parts)] defs) - (^ (list& name [meta-rec-cursor (#;Record meta-rec-parts)] type defs)) - (#Some name #Nil type [meta-rec-cursor (#;Record meta-rec-parts)] defs) + (^ (list& name [meta-rec-cursor (#Record meta-rec-parts)] type defs)) + (#Some name #Nil type [meta-rec-cursor (#Record meta-rec-parts)] defs) (^ (list& [_ (#Form (list& name args))] type defs)) (#Some name args type (` {}) defs) @@ -3727,59 +3735,59 @@ (case ?parts (#Some [name args type meta defs]) (case (case name - [_ (#;Symbol ["" "_"])] + [_ (#Symbol ["" "_"])] (case type - (^ [_ (#;Form (list& [_ (#;Symbol [_ sig-name])] sig-args))]) + (^ [_ (#Form (list& [_ (#Symbol [_ sig-name])] sig-args))]) (case (: (Maybe (List Text)) (monad/map Monad<Maybe> (function [sa] (case sa - [_ (#;Symbol [_ arg-name])] - (#;Some arg-name) + [_ (#Symbol [_ arg-name])] + (#Some arg-name) _ - #;None)) + #None)) sig-args)) - (^ (#;Some params)) - (#;Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")])) + (^ (#Some params)) + (#Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")])) _ - #;None) + #None) _ - #;None) + #None) _ - (#;Some name) + (#Some name) ) - (#;Some name) + (#Some name) (let [usage (case args #Nil name _ (` ((~ name) (~@ args))))] - (return (list (` (;;def: (~@ (export-level exported?)) (~ usage) - (~ (meta-code-merge (` {#;struct? true}) + (return (list (` (..def: (~@ (export-level exported?)) (~ usage) + (~ (meta-code-merge (` {#.struct? true}) meta)) (~ type) (struct (~@ defs))))))) - #;None + #None (fail "Cannot infer name, so struct must have a name other than \"_\"!")) #None (fail "Wrong syntax for struct:")))) (def: #export (id x) - {#;doc "Identity function. + {#.doc "Identity function. Does nothing to it's argument and just returns it."} (All [a] (-> a a)) x) (macro: #export (type: tokens) - {#;doc "## The type-definition macro. + {#.doc "## The type-definition macro. (type: (List a) #Nil (#Cons a (List a)))"} @@ -3792,20 +3800,20 @@ [false tokens']) parts (: (Maybe [Text (List Code) Code (List Code)]) (case tokens' - (^ (list [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)])) - (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])]) + (^ (list [_ (#Symbol "" name)] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)])) + (#Some [name #Nil [meta-cursor (#Record meta-parts)] (list [type-cursor (#Record type-parts)])]) - (^ (list& [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] type-code1 type-codes)) - (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)]) + (^ (list& [_ (#Symbol "" name)] [meta-cursor (#Record meta-parts)] type-code1 type-codes)) + (#Some [name #Nil [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)]) (^ (list& [_ (#Symbol "" name)] type-codes)) (#Some [name #Nil (` {}) type-codes]) - (^ (list [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)])) - (#Some [name args [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])]) + (^ (list [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)])) + (#Some [name args [meta-cursor (#Record meta-parts)] (list [type-cursor (#Record type-parts)])]) - (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] type-code1 type-codes)) - (#Some [name args [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)]) + (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#Record meta-parts)] type-code1 type-codes)) + (#Some [name args [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)]) (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] type-codes)) (#Some [name args (` {}) type-codes]) @@ -3822,19 +3830,19 @@ type-meta (: Code (case tags?? (#Some tags) - (` {#;tags [(~@ (map text$ tags))] - #;type? true}) + (` {#.tags [(~@ (map text$ tags))] + #.type? true}) _ - (` {#;type? true}))) + (` {#.type? true}))) type' (: (Maybe Code) (if rec? (if (empty? args) (let [g!param (symbol$ ["" ""]) prime-name (symbol$ ["" name]) - type+ (replace-syntax (list [name (` ((~ prime-name) #;Void))]) type)] + type+ (replace-syntax (list [name (` ((~ prime-name) #.Void))]) type)] (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) - #;Void)))) + #.Void)))) #None) (case args #Nil @@ -3844,13 +3852,13 @@ (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))] (case type' (#Some type'') - (return (list (` (;;def: (~@ (export-level exported?)) (~ type-name) + (return (list (` (..def: (~@ (export-level exported?)) (~ type-name) (~ ($_ meta-code-merge (with-type-args args) - (if rec? (' {#;type-rec? true}) (' {})) + (if rec? (' {#.type-rec? true}) (' {})) type-meta meta)) Type - (#;Named [(~ (text$ module-name)) + (#.Named [(~ (text$ module-name)) (~ (text$ name))] (type (~ type''))))))) @@ -4064,10 +4072,10 @@ (def: (count-ups ups input) (-> Nat Text Nat) (case ("lux text index" input "/" ups) - #;None + #None ups - (#;Some found) + (#Some found) (if (n/= ups found) (count-ups (n/+ +1 ups) input) ups))) @@ -4075,10 +4083,10 @@ (def: (list/drop amount a+) (All [a] (-> Nat (List a) (List a))) (case [amount a+] - (^or [+0 _] [_ #;Nil]) + (^or [+0 _] [_ #Nil]) a+ - [_ (#;Cons _ a+')] + [_ (#Cons _ a+')] (list/drop (n/- +1 amount) a+'))) (def: (clean-module relative-root module) @@ -4146,7 +4154,7 @@ openings+extra (parse-short-openings extra) #let [[openings extra] openings+extra]] (wrap (list {#import-name m-name - #import-alias (#;Some (replace-all ";" m-name alias)) + #import-alias (#Some (replace-all "." m-name alias)) #import-refer {#refer-defs referral #refer-open openings}}))) @@ -4158,7 +4166,7 @@ openings+extra (parse-short-openings extra) #let [[openings extra] openings+extra]] (wrap (list {#import-name m-name - #import-alias (#;Some raw-m-name) + #import-alias (#Some raw-m-name) #import-refer {#refer-defs referral #refer-open openings}}))) @@ -4184,7 +4192,7 @@ (function [[name [def-type def-meta def-value]]] (case [(get-meta ["lux" "export?"] def-meta) (get-meta ["lux" "hidden?"] def-meta)] - [(#Some [_ (#Bool true)]) #;None] + [(#Some [_ (#Bool true)]) #None] (list name) _ @@ -4200,12 +4208,12 @@ (def: (filter p xs) (All [a] (-> (-> a Bool) (List a) (List a))) (case xs - #;Nil + #Nil (list) - (#;Cons x xs') + (#Cons x xs') (if (p x) - (#;Cons x (filter p xs')) + (#Cons x (filter p xs')) (filter p xs')))) (def: (is-member? cases name) @@ -4221,8 +4229,8 @@ (All [a b] (-> (-> a (Maybe b)) a a (Maybe b))) (case (f x1) - #;None (f x2) - (#;Some y) (#;Some y))) + #None (f x2) + (#Some y) (#Some y))) (def: (find-in-env name state) (-> Text Compiler (Maybe Type)) @@ -4288,10 +4296,10 @@ (def: (find-type-var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings - #;Nil - #;Nil + #Nil + #Nil - (#;Cons [var bound] bindings') + (#Cons [var bound] bindings') (if (n/= idx var) bound (find-type-var idx bindings')))) @@ -4328,10 +4336,10 @@ #scope-type-vars _} compiler {#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context] (case (find-type-var type-id var-bindings) - #;None + #None temp - (#;Some actualT) + (#Some actualT) (#Right [compiler actualT]))) _ @@ -4357,7 +4365,7 @@ (case type (#Primitive name params) (case params - #;Nil + #Nil name _ @@ -4401,7 +4409,7 @@ ")")) (#Named [prefix name] _) - ($_ text/compose prefix ";" name) + ($_ text/compose prefix "." name) )) (macro: #hidden (^open' tokens) @@ -4411,10 +4419,10 @@ [init-type (find-type name) struct-evidence (resolve-type-tags init-type)] (case struct-evidence - #;None + #None (fail (text/compose "Can only \"open\" structs: " (type/show init-type))) - (#;Some tags&members) + (#Some tags&members) (do Monad<Meta> [full-body ((: (-> Ident [(List Ident) (List Type)] Code (Meta Code)) (function recur [source [tags members] target] @@ -4428,12 +4436,12 @@ (do Monad<Meta> [m-structure (resolve-type-tags m-type)] (case m-structure - (#;Some m-tags&members) + (#Some m-tags&members) (recur ["" (text/compose prefix m-name)] m-tags&members enhanced-target) - #;None + #None (wrap enhanced-target)))) target (zip2 tags members))] @@ -4445,7 +4453,7 @@ (fail "Wrong syntax for ^open"))) (macro: #export (^open tokens) - {#;doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. + {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. ## Can optionally take a \"prefix\" text for the generated local bindings. (def: #export (range (^open) from to) (All [a] (-> (Enum a) a a (List a))) @@ -4457,13 +4465,13 @@ (return (list& g!temp (` (^open' (~ g!temp) (~ (text$ prefix)) (~ body))) branches))) (^ (list& [_ (#Form (list))] body branches)) - (return (list& (` (;;^open "")) body branches)) + (return (list& (` (..^open "")) body branches)) _ (fail "Wrong syntax for ^open"))) (macro: #export (cond tokens) - {#;doc "## Branching structures with multiple test conditions. + {#.doc "## Branching structures with multiple test conditions. (cond (n/even? num) \"even\" (n/odd? num) \"odd\" ## else-branch @@ -4496,7 +4504,7 @@ (enumerate' +0 xs)) (macro: #export (get@ tokens) - {#;doc "## Accesses the value of a record at a given tag. + {#.doc "## Accesses the value of a record at a given tag. (get@ #field my-record) ## Can also work with multiple levels of nesting: @@ -4530,14 +4538,14 @@ (^ (list [_ (#Tuple slots)] record)) (return (list (list/fold (: (-> Code Code Code) (function [slot inner] - (` (;;get@ (~ slot) (~ inner))))) + (` (..get@ (~ slot) (~ inner))))) record slots))) (^ (list selector)) (do Monad<Meta> [g!record (gensym "record")] - (wrap (list (` (function [(~ g!record)] (;;get@ (~ selector) (~ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..get@ (~ selector) (~ g!record))))))) _ (fail "Wrong syntax for get@"))) @@ -4558,10 +4566,10 @@ _ (return (list (` ("lux def" (~ (symbol$ ["" (text/compose prefix name)])) (~ source+) - [(~ cursor-code) (#;Record #Nil)]))))))) + [(~ cursor-code) (#.Record #Nil)]))))))) (macro: #export (open tokens) - {#;doc "## Opens a structure and generates a definition for each of its members (including nested members). + {#.doc "## Opens a structure and generates a definition for each of its members (including nested members). ## For example: (open Number<Int> \"i:\") ## Will generate: @@ -4597,7 +4605,7 @@ (fail "Wrong syntax for open"))) (macro: #export (|>> tokens) - {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. + {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. (|>> (map int/encode) (interpose \" \") (fold text/compose \"\")) ## => (function [<arg>] @@ -4609,7 +4617,7 @@ (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) (macro: #export (<<| tokens) - {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. + {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. (<<| (fold text/compose \"\") (interpose \" \") (map int/encode)) ## => (function [<arg>] @@ -4645,7 +4653,7 @@ (fail ($_ text/compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))]] (case options - #;Nil + #Nil (wrap {#refer-defs referral #refer-open openings}) @@ -4692,8 +4700,8 @@ (` ("lux def" (~ (symbol$ ["" def])) (~ (symbol$ [module-name def])) [(~ cursor-code) - (#;Record (#Cons [[(~ cursor-code) (#;Tag ["lux" "alias"])] - [(~ cursor-code) (#;Symbol [(~ (text$ module-name)) (~ (text$ def))])]] + (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])] + [(~ cursor-code) (#.Symbol [(~ (text$ module-name)) (~ (text$ def))])]] #Nil))])))) defs') openings (join-map (: (-> Openings (List Code)) @@ -4734,17 +4742,17 @@ =opens (join-map (function [[prefix structs]] (list& (text$ prefix) (map symbol$ structs))) r-opens)] - (` (;;refer (~ (text$ module-name)) + (` (..refer (~ (text$ module-name)) (~@ =defs) (~' #open) ((~@ =opens)))))) (macro: #export (module: tokens) - {#;doc "Module-definition macro. + {#.doc "Module-definition macro. Can take optional annotations and allows the specification of modules to import. ## Examples - (;module: {#;doc \"Some documentation...\"} + (.module: {#.doc \"Some documentation...\"} lux (lux (control (monad #as M #refer #all)) (data (text #open (\"text/\" Monoid<Text>)) @@ -4755,7 +4763,7 @@ (macro code)) (// (type #open (\"\" Eq<Type>)))) - (;module: {#;doc \"Some documentation...\"} + (.module: {#.doc \"Some documentation...\"} lux (lux (control [\"M\" monad #*]) (data [text \"text/\" Monoid<Text>] @@ -4783,14 +4791,14 @@ (function [[m-name m-alias =refer]] (refer-to-code m-name =refer))) imports) - =meta (process-def-meta (list& [(` #;imports) (` [(~@ =imports)])] + =meta (process-def-meta (list& [(` #.imports) (` [(~@ =imports)])] _meta)) =module (` ("lux module" [(~ cursor-code) - (#;Record (~ =meta))]))]] - (wrap (#;Cons =module =refers)))) + (#.Record (~ =meta))]))]] + (wrap (#Cons =module =refers)))) (macro: #export (:: tokens) - {#;doc "## Allows accessing the value of a structure's member. + {#.doc "## Allows accessing the value of a structure's member. (:: Codec<Text,Int> encode) ## Also allows using that value as a function. @@ -4806,7 +4814,7 @@ (fail "Wrong syntax for ::"))) (macro: #export (set@ tokens) - {#;doc "## Sets the value of a record at a given tag. + {#.doc "## Sets the value of a record at a given tag. (set@ #name \"Lux\" lang) ## Can also work with multiple levels of nesting: @@ -4852,7 +4860,7 @@ (^ (list [_ (#Tuple slots)] value record)) (case slots - #;Nil + #Nil (fail "Wrong syntax for set@") _ @@ -4864,14 +4872,14 @@ #let [pairs (zip2 slots bindings) update-expr (list/fold (: (-> [Code Code] Code Code) (function [[s b] v] - (` (;;set@ (~ s) (~ v) (~ b))))) + (` (..set@ (~ s) (~ v) (~ b))))) value (list/reverse pairs)) [_ accesses'] (list/fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function [[new-slot new-binding] [old-record accesses']] [(` (get@ (~ new-slot) (~ new-binding))) - (#;Cons (list new-binding old-record) accesses')])) - [record (: (List (List Code)) #;Nil)] + (#Cons (list new-binding old-record) accesses')])) + [record (: (List (List Code)) #Nil)] pairs) accesses (list/join (list/reverse accesses'))]] (wrap (list (` (let [(~@ accesses)] @@ -4880,19 +4888,19 @@ (^ (list selector value)) (do Monad<Meta> [g!record (gensym "record")] - (wrap (list (` (function [(~ g!record)] (;;set@ (~ selector) (~ value) (~ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) (do Monad<Meta> [g!value (gensym "value") g!record (gensym "record")] - (wrap (list (` (function [(~ g!value) (~ g!record)] (;;set@ (~ selector) (~ g!value) (~ g!record))))))) + (wrap (list (` (function [(~ g!value) (~ g!record)] (..set@ (~ selector) (~ g!value) (~ g!record))))))) _ (fail "Wrong syntax for set@"))) (macro: #export (update@ tokens) - {#;doc "## Modifies the value of a record at a given tag, based on some function. + {#.doc "## Modifies the value of a record at a given tag, based on some function. (update@ #age i/inc person) ## Can also work with multiple levels of nesting: @@ -4938,7 +4946,7 @@ (^ (list [_ (#Tuple slots)] fun record)) (case slots - #;Nil + #Nil (fail "Wrong syntax for update@") _ @@ -4952,49 +4960,49 @@ (^ (list selector fun)) (do Monad<Meta> [g!record (gensym "record")] - (wrap (list (` (function [(~ g!record)] (;;update@ (~ selector) (~ fun) (~ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) (do Monad<Meta> [g!fun (gensym "fun") g!record (gensym "record")] - (wrap (list (` (function [(~ g!fun) (~ g!record)] (;;update@ (~ selector) (~ g!fun) (~ g!record))))))) + (wrap (list (` (function [(~ g!fun) (~ g!record)] (..update@ (~ selector) (~ g!fun) (~ g!record))))))) _ (fail "Wrong syntax for update@"))) (macro: #export (^template tokens) - {#;doc "## It's similar to do-template, but meant to be used during pattern-matching. + {#.doc "## It's similar to do-template, but meant to be used during pattern-matching. (def: (beta-reduce env type) (-> (List Type) Type Type) (case type - (#;Primitive name params) - (#;Primitive name (list/map (beta-reduce env) params)) + (#.Primitive name params) + (#.Primitive name (list/map (beta-reduce env) params)) (^template [<tag>] (<tag> left right) (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#;Sum] [#;Product]) + ([#.Sum] [#.Product]) (^template [<tag>] (<tag> left right) (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#;Function] - [#;Apply]) + ([#.Function] + [#.Apply]) (^template [<tag>] (<tag> old-env def) (case old-env - #;Nil + #.Nil (<tag> env def) _ type)) - ([#;UnivQ] - [#;ExQ]) + ([#.UnivQ] + [#.ExQ]) - (#;Bound idx) - (default type (list;nth idx env)) + (#.Bound idx) + (default type (list.nth idx env)) _ type @@ -5013,7 +5021,7 @@ (|> data' (join-map (compose apply (make-env bindings'))) wrap)) - #;None))) + #None))) (#Some output) (return (list/compose output branches)) @@ -5066,7 +5074,7 @@ (def: (identify-doc-fragment code) (-> Code Doc-Fragment) (case code - [_ (#;Text comment)] + [_ (#Text comment)] (#Doc-Comment comment) _ @@ -5088,7 +5096,7 @@ (do-template [<name> <op> <one> <type> <doc>] [(def: #export (<name> value) - {#;doc <doc>} + {#.doc <doc>} (-> <type> <type>) (<op> <one> value))] @@ -5116,8 +5124,8 @@ (def: (repeat n x) (All [a] (-> Int a (List a))) (if (i/> 0 n) - (#;Cons x (repeat (i/+ -1 n) x)) - #;Nil)) + (#Cons x (repeat (i/+ -1 n) x)) + #Nil)) (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Cursor Cursor Text) @@ -5200,7 +5208,7 @@ (text/compose text "\n\n")))) (macro: #export (doc tokens) - {#;doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given. + {#.doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given. ## For Example: (doc \"Allows arbitrary looping, using the \\\"recur\\\" form to re-start the loop. @@ -5211,7 +5219,7 @@ (recur (i/inc count) (f x)) x)))"} (return (list (` [(~ cursor-code) - (#;Text (~ (|> tokens + (#.Text (~ (|> tokens (map (|>> identify-doc-fragment doc-fragment->Text)) text/join text$)))])))) @@ -5275,7 +5283,7 @@ )) (macro: #export (loop tokens) - {#;doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." + {#.doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." "Can be used in monadic code to create monadic loops." (loop [count 0 x init] @@ -5306,14 +5314,14 @@ (function [_] (gensym ""))) inits)] (return (list (` (let [(~@ (interleave aliases inits))] - (;loop [(~@ (interleave vars aliases))] + (.loop [(~@ (interleave vars aliases))] (~ body))))))))) _ (fail "Wrong syntax for loop"))) (macro: #export (^slots tokens) - {#;doc (doc "Allows you to extract record members as local variables with the same names." + {#.doc (doc "Allows you to extract record members as local variables with the same names." "For example:" (let [(^slots [#foo #bar #baz]) quux] (f foo bar baz)))} @@ -5391,7 +5399,7 @@ )) (macro: #export (with-expansions tokens) - {#;doc (doc "Controlled macro-expansion." + {#.doc (doc "Controlled macro-expansion." "Bind an arbitraty number of Codes resulting from macro-expansion to local bindings." "Wherever a binding appears, the bound Codes will be spliced in there." (test: "Code operations & structures" @@ -5401,18 +5409,18 @@ (compare <text> (:: Code/encode show <expr>)) (compare true (:: Eq<Code> = <expr> <expr>))] - [(bool true) "true" [_ (#;Bool true)]] - [(bool false) "false" [_ (#;Bool false)]] - [(int 123) "123" [_ (#;Int 123)]] - [(frac 123.0) "123.0" [_ (#;Frac 123.0)]] - [(text "\n") "\"\\n\"" [_ (#;Text "\n")]] - [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;Tag ["yolo" "lol"])]] - [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;Symbol ["yolo" "lol"])]] - [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;Form (list [_ (#;Bool true)] [_ (#;Int 123)]))])] - [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;Tuple (list [_ (#;Bool true)] [_ (#;Int 123)]))])] - [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;Record (list [[_ (#;Bool true)] [_ (#;Int 123)]]))])] - [(local-tag "lol") "#lol" [_ (#;Tag ["" "lol"])]] - [(local-symbol "lol") "lol" [_ (#;Symbol ["" "lol"])]] + [(bool true) "true" [_ (#.Bool true)]] + [(bool false) "false" [_ (#.Bool false)]] + [(int 123) "123" [_ (#.Int 123)]] + [(frac 123.0) "123.0" [_ (#.Frac 123.0)]] + [(text "\n") "\"\\n\"" [_ (#.Text "\n")]] + [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] + [(symbol ["yolo" "lol"]) "yolo.lol" [_ (#.Symbol ["yolo" "lol"])]] + [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#.Form (list [_ (#.Bool true)] [_ (#.Int 123)]))])] + [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#.Tuple (list [_ (#.Bool true)] [_ (#.Int 123)]))])] + [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#.Record (list [[_ (#.Bool true)] [_ (#.Int 123)]]))])] + [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] + [(local-symbol "lol") "lol" [_ (#.Symbol ["" "lol"])]] )] (test-all <tests>))))} (case tokens @@ -5421,7 +5429,7 @@ (^ (list& [_ (#Symbol ["" var-name])] macro-expr bindings')) (do Monad<Meta> [expansion (macro-expand-once macro-expr)] - (case (place-tokens var-name expansion (` (;with-expansions + (case (place-tokens var-name expansion (` (.with-expansions [(~@ bindings')] (~@ bodies)))) (#Some output) @@ -5509,12 +5517,12 @@ )) (macro: #export (^~ tokens) - {#;doc (doc "Use global defs with simple values, such as text, int, frac and bool in place of literals in patterns." + {#.doc (doc "Use global defs with simple values, such as text, int, frac and bool in place of literals in patterns." "The definitions must be properly-qualified (though you may use one of the short-cuts Lux provides)." (def: (empty?' node) (All [K V] (-> (Node K V) Bool)) (case node - (^~ (#Base ;;clean-bitmap _)) + (^~ (#Base ..clean-bitmap _)) true _ @@ -5542,7 +5550,7 @@ (def: (case-level^ level) (-> Code (Meta [Code Code])) (case level - (^ [_ (#;Tuple (list expr binding))]) + (^ [_ (#Tuple (list expr binding))]) (return [expr binding]) _ @@ -5552,10 +5560,10 @@ (def: (multi-level-case^ levels) (-> (List Code) (Meta Multi-Level-Case)) (case levels - #;Nil + #Nil (fail "Multi-level patterns cannot be empty.") - (#;Cons init extras) + (#Cons init extras) (do Monad<Meta> [extras' (monad/map Monad<Meta> case-level^ extras)] (wrap [init extras'])))) @@ -5568,47 +5576,47 @@ (~ success) (~ g!_) - #;None))) - (` (#;Some (~ body))) + #.None))) + (` (#.Some (~ body))) (: (List [Code Code]) (list/reverse levels)))] (list init-pattern inner-pattern-body))) (macro: #export (^multi tokens) - {#;doc (doc "Multi-level pattern matching." + {#.doc (doc "Multi-level pattern matching." "Useful in situations where the result of a branch depends on further refinements on the values being matched." "For example:" (case (split (size static) uri) - (^multi (#;Some [chunk uri']) [(text/= static chunk) true]) + (^multi (#.Some [chunk uri']) [(text/= static chunk) true]) (match-uri endpoint? parts' uri') _ - (#;Left (format "Static part " (%t static) " does not match URI: " uri))) + (#.Left (format "Static part " (%t static) " does not match URI: " uri))) "Short-cuts can be taken when using boolean tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#;Some [chunk uri']) (text/= static chunk)) + (^multi (#.Some [chunk uri']) (text/= static chunk)) (match-uri endpoint? parts' uri') _ - (#;Left (format "Static part " (%t static) " does not match URI: " uri))))} + (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} (case tokens - (^ (list& [_meta (#;Form levels)] body next-branches)) + (^ (list& [_meta (#Form levels)] body next-branches)) (do Monad<Meta> [mlc (multi-level-case^ levels) expected get-expected-type g!temp (gensym "temp")] (let [output (list g!temp - (` ("lux case" ("lux check" (#;Apply (~ (type-to-code expected)) Maybe) + (` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe) (case (~ g!temp) (~@ (multi-level-case$ g!temp [mlc body])) (~ g!temp) - #;None)) - {(#;Some (~ g!temp)) + #.None)) + {(#Some (~ g!temp)) (~ g!temp) - #;None + #None (case (~ g!temp) (~@ next-branches))})))] (wrap output))) @@ -5617,15 +5625,15 @@ (fail "Wrong syntax for ^multi"))) (macro: #export (ident-for tokens) - {#;doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." - (ident-for #;doc) + {#.doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." + (ident-for #.doc) "=>" ["lux" "doc"])} (case tokens (^template [<tag>] (^ (list [_ (<tag> [prefix name])])) (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) - ([#;Symbol] [#;Tag]) + ([#Symbol] [#Tag]) _ (fail "Wrong syntax for ident-for"))) @@ -5655,16 +5663,16 @@ (def: (list-at idx xs) (All [a] (-> Nat (List a) (Maybe a))) (case xs - #;Nil - #;None + #Nil + #None - (#;Cons x xs') + (#Cons x xs') (if (n/= +0 idx) - (#;Some x) + (#Some x) (list-at (n/dec idx) xs')))) (macro: #export ($ tokens) - {#;doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." + {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." "In the example below, +0 corresponds to the 'a' variable." (def: #export (from-list list) (All [a] (-> (List a) (Sequence a))) @@ -5677,17 +5685,17 @@ (do Monad<Meta> [stvs get-scope-type-vars] (case (list-at idx (list/reverse stvs)) - (#;Some var-id) + (#Some var-id) (wrap (list (` (#Ex (~ (nat$ var-id)))))) - #;None + #None (fail (text/compose "Indexed-type does not exist: " (nat/encode idx))))) _ (fail "Wrong syntax for $"))) (def: #export (is reference sample) - {#;doc (doc "Tests whether the 2 values are identical (not just \"equal\")." + {#.doc (doc "Tests whether the 2 values are identical (not just \"equal\")." "This one should succeed:" (let [value 5] (is value value)) @@ -5698,13 +5706,13 @@ ("lux is" reference sample)) (macro: #export (^@ tokens) - {#;doc (doc "Allows you to simultaneously bind and de-structure a value." + {#.doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [Hash<a> _])) (list/fold (function [elem acc] (n/+ (:: Hash<a> hash elem) acc)) +0 (to-list set))))} (case tokens - (^ (list& [_meta (#;Form (list [_ (#;Symbol ["" name])] pattern))] body branches)) + (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] pattern))] body branches)) (let [g!whole (symbol$ ["" name])] (return (list& g!whole (` (case (~ g!whole) (~ pattern) (~ body))) @@ -5714,12 +5722,12 @@ (fail "Wrong syntax for ^@"))) (macro: #export (^|> tokens) - {#;doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." + {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." (case input (^|> value [n/inc (n/% +10) (n/max +1)]) (foo value)))} (case tokens - (^ (list& [_meta (#;Form (list [_ (#;Symbol ["" name])] [_ (#;Tuple steps)]))] body branches)) + (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches)) (let [g!name (symbol$ ["" name])] (return (list& g!name (` (let [(~ g!name) (|> (~ g!name) (~@ steps))] @@ -5730,7 +5738,7 @@ (fail "Wrong syntax for ^|>"))) (macro: #export (:!! tokens) - {#;doc (doc "Coerces the given expression to the type of whatever is expected." + {#.doc (doc "Coerces the given expression to the type of whatever is expected." (: Dinosaur (:!! (list 1 2 3))))} (case tokens (^ (list expr)) @@ -5742,27 +5750,27 @@ (fail "Wrong syntax for :!!"))) (macro: #export (undefined tokens) - {#;doc (doc "Meant to be used as a stand-in for functions with undefined implementations." + {#.doc (doc "Meant to be used as a stand-in for functions with undefined implementations." "Undefined expressions will type-check against everything, so they make good dummy implementations." "However, if an undefined expression is ever evaluated, it will raise a runtime error." (def: (square x) (-> Int Int) (undefined)))} (case tokens - #;Nil + #Nil (return (list (` (error! "Undefined behavior.")))) _ (fail "Wrong syntax for undefined"))) (macro: #export (type-of tokens) - {#;doc (doc "Generates the type corresponding to a given definition or variable." + {#.doc (doc "Generates the type corresponding to a given definition or variable." (let [my-num (: Int 123)] (type-of my-num)) "==" Int)} (case tokens - (^ (list [_ (#;Symbol var-name)])) + (^ (list [_ (#Symbol var-name)])) (do Monad<Meta> [var-type (find-type var-name)] (wrap (list (type-to-code var-type)))) @@ -5778,25 +5786,25 @@ (-> (List Code) (Meta [(Maybe Export-Level') (List Code)])) (case tokens (^ (list& [_ (#Tag ["" "export"])] tokens')) - (return [(#;Some #Export) tokens']) + (return [(#Some #Export) tokens']) (^ (list& [_ (#Tag ["" "hidden"])] tokens')) - (return [(#;Some #Hidden) tokens']) + (return [(#Some #Hidden) tokens']) _ - (return [#;None tokens]) + (return [#None tokens]) )) (def: (gen-export-level ?export-level) (-> (Maybe Export-Level') (List Code)) (case ?export-level - #;None + #None (list) - (#;Some #Export) + (#Some #Export) (list (' #export)) - (#;Some #Hidden) + (#Some #Hidden) (list (' #hidden)) )) @@ -5851,7 +5859,7 @@ )) (macro: #export (template: tokens) - {#;doc (doc "Define macros in the style of do-template and ^template." + {#.doc (doc "Define macros in the style of do-template and ^template." "For simple macros that do not need any fancy features." (template: (square x) (i/* x x)))} @@ -5876,16 +5884,16 @@ (~ anns) (case (~ g!tokens) (^ (list (~@ (map (|>> [""] symbol$) args)))) - (#;Right [(~ g!compiler) + (#.Right [(~ g!compiler) (list (` (~ (replace-syntax rep-env input-template))))]) (~ g!_) - (#;Left (~ (text$ (text/compose "Wrong syntax for " name)))) + (#.Left (~ (text$ (text/compose "Wrong syntax for " name)))) ))))) )) (macro: #export (as-is tokens compiler) - (#;Right [compiler tokens])) + (#Right [compiler tokens])) (macro: #export (char tokens compiler) (case tokens @@ -5894,10 +5902,10 @@ (|> ("lux text char" input +0) (default (undefined)) nat$ list - [compiler] #;Right) + [compiler] #Right) _ - (#;Left "Wrong syntax for char"))) + (#Left "Wrong syntax for char"))) (def: #export (when test f) (All [a] (-> Bool (-> a a) (-> a a))) @@ -5907,25 +5915,25 @@ value))) (type: #export (Array a) - {#;doc "Mutable arrays."} - (#;Primitive "#Array" (#;Cons a #;Nil))) + {#.doc "Mutable arrays."} + (#.Primitive "#Array" (#.Cons a #.Nil))) (def: target (Meta Text) (function [compiler] - (#;Right [compiler (get@ [#info #target] compiler)]))) + (#Right [compiler (get@ [#info #target] compiler)]))) (def: (pick-for-target target options) (-> Text (List [Code Code]) (Maybe Code)) (case options - #;Nil - #;None + #Nil + #None - (#;Cons [key value] options') + (#Cons [key value] options') (case key (^multi [_ (#Text platform)] (text/= target platform)) - (#;Some value) + (#Some value) _ (pick-for-target target options')) @@ -5937,14 +5945,14 @@ (case tokens (^ (list [_ (#Record options)])) (case (pick-for-target target options) - (#;Some pick) + (#Some pick) (wrap (list pick)) - #;None + #None (fail ($_ text/compose "No code for target platform: " target))) (^ (list [_ (#Record options)] default)) - (wrap (list (;;default default (pick-for-target target options)))) + (wrap (list (..default default (pick-for-target target options)))) _ (fail "Wrong syntax for 'for'")))) @@ -6017,7 +6025,7 @@ last (#Cons [init inits']) - (` (#;Cons (~ init) (~ (untemplate-list& last inits')))))) + (` (#.Cons (~ init) (~ (untemplate-list& last inits')))))) (def: (untemplate-pattern pattern) (-> Code (Meta Code)) @@ -6046,7 +6054,7 @@ (wrap (` [(~ =key) (~ =value)])))) fields) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (#;Record (~ (untemplate-list =fields)))]))) + (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))]))) [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))] (return unquoted) @@ -6057,8 +6065,8 @@ (^template [<tag>] [_ (<tag> elems)] (case (list/reverse elems) - (#;Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - inits) + (#Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + inits) (do Monad<Meta> [=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits)) g!meta (gensym "g!meta")] @@ -6069,12 +6077,12 @@ [=elems (monad/map Monad<Meta> untemplate-pattern elems) g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))]))))) - ([#;Tuple] [#;Form]) + ([#Tuple] [#Form]) )) (macro: #export (^code tokens) (case tokens - (^ (list& [_meta (#;Form (list template))] body branches)) + (^ (list& [_meta (#Form (list template))] body branches)) (do Monad<Meta> [pattern (untemplate-pattern template)] (wrap (list& pattern body branches))) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 6d4036b18..328d717ce 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control monad ["p" parser]) @@ -13,81 +13,81 @@ ## [Types] (type: #export (CLI a) - {#;doc "A command-line interface parser."} - (p;Parser (List Text) a)) + {#.doc "A command-line interface parser."} + (p.Parser (List Text) a)) ## [Combinators] (def: #export (run inputs parser) - (All [a] (-> (List Text) (CLI a) (E;Error a))) - (case (p;run inputs parser) - (#E;Success [remaining output]) + (All [a] (-> (List Text) (CLI a) (E.Error a))) + (case (p.run inputs parser) + (#E.Success [remaining output]) (case remaining - #;Nil - (#E;Success output) + #.Nil + (#E.Success output) _ - (#E;Error (format "Remaining CLI inputs: " (text;join-with " " remaining)))) + (#E.Error (format "Remaining CLI inputs: " (text.join-with " " remaining)))) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) (def: #export any - {#;doc "Just returns the next input without applying any logic."} + {#.doc "Just returns the next input without applying any logic."} (CLI Text) (function [inputs] (case inputs - (#;Cons arg inputs') - (#E;Success [inputs' arg]) + (#.Cons arg inputs') + (#E.Success [inputs' arg]) _ - (#E;Error "Cannot parse empty arguments.")))) + (#E.Error "Cannot parse empty arguments.")))) (def: #export (parse parser) - {#;doc "Parses the next input with a parsing function."} - (All [a] (-> (-> Text (E;Error a)) (CLI a))) + {#.doc "Parses the next input with a parsing function."} + (All [a] (-> (-> Text (E.Error a)) (CLI a))) (function [inputs] - (do E;Monad<Error> + (do E.Monad<Error> [[remaining raw] (any inputs) output (parser raw)] (wrap [remaining output])))) (def: #export (this reference) - {#;doc "Checks that a token is in the inputs."} + {#.doc "Checks that a token is in the inputs."} (-> Text (CLI Unit)) (function [inputs] - (do E;Monad<Error> + (do E.Monad<Error> [[remaining raw] (any inputs)] (if (text/= reference raw) (wrap [remaining []]) - (E;fail (format "Missing token: \"" reference "\"")))))) + (E.fail (format "Missing token: \"" reference "\"")))))) (def: #export (somewhere cli) - {#;doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."} + {#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."} (All [a] (-> (CLI a) (CLI a))) (function [inputs] (loop [immediate inputs] - (case (p;run immediate cli) - (#E;Success [remaining output]) - (#E;Success [remaining output]) + (case (p.run immediate cli) + (#E.Success [remaining output]) + (#E.Success [remaining output]) - (#E;Error error) + (#E.Error error) (case immediate - #;Nil - (#E;Error error) + #.Nil + (#E.Error error) - (#;Cons to-omit immediate') - (do E;Monad<Error> + (#.Cons to-omit immediate') + (do E.Monad<Error> [[remaining output] (recur immediate')] - (wrap [(#;Cons to-omit remaining) + (wrap [(#.Cons to-omit remaining) output]))))))) (def: #export end - {#;doc "Ensures there are no more inputs."} + {#.doc "Ensures there are no more inputs."} (CLI Unit) (function [inputs] (case inputs - #;Nil (#E;Success [inputs []]) - _ (#E;Error (format "Unknown parameters: " (text;join-with " " inputs)))))) + #.Nil (#E.Success [inputs []]) + _ (#E.Error (format "Unknown parameters: " (text.join-with " " inputs)))))) ## [Syntax] (type: Program-Args @@ -96,16 +96,16 @@ (def: program-args^ (Syntax Program-Args) - (p;alt s;local-symbol - (s;form (p;some (p;either (do p;Monad<Parser> - [name s;local-symbol] - (wrap [(code;symbol ["" name]) (` any)])) - (s;tuple (p;seq s;any s;any))))))) + (p.alt s.local-symbol + (s.form (p.some (p.either (do p.Monad<Parser> + [name s.local-symbol] + (wrap [(code.symbol ["" name]) (` any)])) + (s.tuple (p.seq s.any s.any))))))) -(def: #hidden _Monad<CLI>_ p;Monad<Parser>) +(def: #hidden _Monad<CLI>_ p.Monad<Parser>) (syntax: #export (program: [args program-args^] body) - {#;doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)." + {#.doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)." "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module." (program: all-args (do Monad<IO> @@ -122,29 +122,29 @@ (do-something data))))} (case args (#Raw args) - (wrap (list (` ("lux program" (~ (code;symbol ["" args])) - (do io;Monad<IO> + (wrap (list (` ("lux program" (~ (code.symbol ["" args])) + (do io.Monad<IO> [] (~ body)))))) (#Parsed args) (with-gensyms [g!args g!_ g!output g!message] (wrap (list (` ("lux program" (~ g!args) - (case ((: (;;CLI (io;IO Unit)) - (do ;;_Monad<CLI>_ + (case ((: (..CLI (io.IO Unit)) + (do .._Monad<CLI>_ [(~@ (|> args (list/map (function [[binding parser]] (list binding parser))) list/join)) - (~ g!_) ;;end] - ((~' wrap) (do io;Monad<IO> + (~ g!_) ..end] + ((~' wrap) (do io.Monad<IO> [] (~ body))))) (~ g!args)) - (#E;Success [(~ g!_) (~ g!output)]) + (#E.Success [(~ g!_) (~ g!output)]) (~ g!output) - (#E;Error (~ g!message)) + (#E.Error (~ g!message)) (error! (~ g!message)) ))) ))) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index abda284c0..75bbf15d2 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "The actor model of concurrency."} +(.module: {#.doc "The actor model of concurrency."} lux (lux (control monad ["p" parser] @@ -27,13 +27,13 @@ ## [Types] (with-expansions - [<Message> (as-is (-> s (Actor s) (T;Task s))) + [<Message> (as-is (-> s (Actor s) (T.Task s))) <Obituary> (as-is [Text s (List <Message>)])] (opaque: #export (Actor s) - {#;doc "An actor, defined as all the necessities it requires."} - {#mailbox (stm;Var <Message>) - #kill-switch (P;Promise Unit) - #obituary (P;Promise <Obituary>)} + {#.doc "An actor, defined as all the necessities it requires."} + {#mailbox (stm.Var <Message>) + #kill-switch (P.Promise Unit) + #obituary (P.Promise <Obituary>)} (type: #export (Message s) <Message>) @@ -42,52 +42,52 @@ <Obituary>) (type: #export (Behavior s) - {#;doc "An actor's behavior when messages are received."} - {#handle (-> (Message s) s (Actor s) (T;Task s)) - #end (-> Text s (P;Promise Unit))}) + {#.doc "An actor's behavior when messages are received."} + {#handle (-> (Message s) s (Actor s) (T.Task s)) + #end (-> Text s (P.Promise Unit))}) (def: #export (spawn behavior init) - {#;doc "Given a behavior and initial state, spawns an actor and returns it."} + {#.doc "Given a behavior and initial state, spawns an actor and returns it."} (All [s] (-> (Behavior s) s (IO (Actor s)))) (io (let [[handle end] behavior self (: (Actor ($ +0)) - (@opaque {#mailbox (stm;var (:! (Message ($ +0)) [])) - #kill-switch (P;promise Unit) - #obituary (P;promise (Obituary ($ +0)))})) - mailbox-channel (io;run (stm;follow (get@ #mailbox (@repr self)))) - |mailbox| (stm;var mailbox-channel) + (@opaque {#mailbox (stm.var (:! (Message ($ +0)) [])) + #kill-switch (P.promise Unit) + #obituary (P.promise (Obituary ($ +0)))})) + mailbox-channel (io.run (stm.follow (get@ #mailbox (@repr self)))) + |mailbox| (stm.var mailbox-channel) _ (P/map (function [_] - (io;run (do Monad<IO> - [mb (stm;read! |mailbox|)] - (frp;close mb)))) + (io.run (do Monad<IO> + [mb (stm.read! |mailbox|)] + (frp.close mb)))) (get@ #kill-switch (@repr self))) process (loop [state init messages mailbox-channel] - (do P;Monad<Promise> + (do P.Monad<Promise> [?messages+ messages] (case ?messages+ ## No kill-switch so far, so I may proceed... - (#;Some [message messages']) - (do P;Monad<Promise> - [#let [_ (io;run (stm;write! messages' |mailbox|))] + (#.Some [message messages']) + (do P.Monad<Promise> + [#let [_ (io.run (stm.write! messages' |mailbox|))] ?state' (handle message state self)] (case ?state' - (#;Left error) + (#.Left error) (do @ - [#let [_ (io;run (do Monad<IO> - [_ (P;resolve [] (get@ #kill-switch (@repr self)))] - (frp;close messages')))] + [#let [_ (io.run (do Monad<IO> + [_ (P.resolve [] (get@ #kill-switch (@repr self)))] + (frp.close messages')))] _ (end error state) - remaining-messages (frp;consume messages')] - (wrap [error state (#;Cons message remaining-messages)])) + remaining-messages (frp.consume messages')] + (wrap [error state (#.Cons message remaining-messages)])) - (#;Right state') + (#.Right state') (recur state' messages'))) ## Otherwise, clean-up and return current state. - #;None - (do P;Monad<Promise> - [#let [_ (io;run (frp;close messages)) + #.None + (do P.Monad<Promise> + [#let [_ (io.run (frp.close messages)) death-message (Killed "")] _ (end death-message state)] (wrap [death-message state (list)])))))] @@ -95,38 +95,38 @@ (def: #export (alive? actor) (All [s] (-> (Actor s) Bool)) - (case [(P;poll (get@ #kill-switch (@repr actor))) - (P;poll (get@ #obituary (@repr actor)))] - [#;None #;None] + (case [(P.poll (get@ #kill-switch (@repr actor))) + (P.poll (get@ #obituary (@repr actor)))] + [#.None #.None] true _ false)) (def: #export (send message actor) - {#;doc "Communicate with an actor through message passing."} + {#.doc "Communicate with an actor through message passing."} (All [s] (-> (Message s) (Actor s) (IO Bool))) (if (alive? actor) (do Monad<IO> - [_ (stm;write! message (get@ #mailbox (@repr actor)))] + [_ (stm.write! message (get@ #mailbox (@repr actor)))] (wrap true)) (io/wrap false))) (def: #export (kill actor) - {#;doc "Immediately kills the given actor (if it is not already dead)."} - (All [s] (-> (Actor s) (io;IO Bool))) + {#.doc "Immediately kills the given actor (if it is not already dead)."} + (All [s] (-> (Actor s) (io.IO Bool))) (if (alive? actor) - (|> actor @repr (get@ #kill-switch) (P;resolve [])) + (|> actor @repr (get@ #kill-switch) (P.resolve [])) (io/wrap false))) )) ## [Values] (def: #export (default-handle message state self) - (All [s] (-> (Message s) s (Actor s) (T;Task s))) + (All [s] (-> (Message s) s (Actor s) (T.Task s))) (message state self)) (def: #export (default-end cause state) - (All [s] (-> Text s (P;Promise Unit))) + (All [s] (-> Text s (P.Promise Unit))) (P/wrap [])) (def: #export default-behavior @@ -135,39 +135,39 @@ #end default-end}) (def: #export (poison actor) - {#;doc "Kills the actor by sending a message that will kill it upon processing, + {#.doc "Kills the actor by sending a message that will kill it upon processing, but allows the actor to handle previous messages."} (All [s] (-> (Actor s) (IO Bool))) (send (function [state self] - (T;throw Poisoned "")) + (T.throw Poisoned "")) actor)) ## [Syntax] (do-template [<with> <resolve> <tag> <desc>] [(def: #hidden (<with> name) - (-> Ident cs;Annotations cs;Annotations) - (|>> (#;Cons [(ident-for <tag>) - (code;tag name)]))) + (-> Ident cs.Annotations cs.Annotations) + (|>> (#.Cons [(ident-for <tag>) + (code.tag name)]))) (def: #hidden (<resolve> name) (-> Ident (Meta Ident)) (do Monad<Meta> - [[_ annotations _] (macro;find-def name)] - (case (macro;get-tag-ann (ident-for <tag>) annotations) - (#;Some actor-name) + [[_ annotations _] (macro.find-def name)] + (case (macro.get-tag-ann (ident-for <tag>) annotations) + (#.Some actor-name) (wrap actor-name) _ - (macro;fail (format "Definition is not " <desc> ".")))))] + (macro.fail (format "Definition is not " <desc> ".")))))] - [with-actor resolve-actor #;;actor "an actor"] - [with-message resolve-message #;;message "a message"] + [with-actor resolve-actor #..actor "an actor"] + [with-message resolve-message #..message "a message"] ) (def: actor-decl^ (Syntax [Text (List Text)]) - (p;either (s;form (p;seq s;local-symbol (p;some s;local-symbol))) - (p;seq s;local-symbol (:: p;Monad<Parser> wrap (list))))) + (p.either (s.form (p.seq s.local-symbol (p.some s.local-symbol))) + (p.seq s.local-symbol (:: p.Monad<Parser> wrap (list))))) (do-template [<name> <desc>] [(def: #hidden <name> @@ -189,26 +189,26 @@ [(Maybe HandleC) (Maybe StopC)]) (def: behavior^ - (s;Syntax BehaviorC) - (let [handle-args ($_ p;seq s;local-symbol s;local-symbol s;local-symbol) - stop-args ($_ p;seq s;local-symbol s;local-symbol)] - (p;seq (p;maybe (s;form (p;seq (s;form (p;after (s;this (' handle)) handle-args)) - s;any))) - (p;maybe (s;form (p;seq (s;form (p;after (s;this (' stop)) stop-args)) - s;any)))))) - -(syntax: #export (actor: [export csr;export] + (s.Syntax BehaviorC) + (let [handle-args ($_ p.seq s.local-symbol s.local-symbol s.local-symbol) + stop-args ($_ p.seq s.local-symbol s.local-symbol)] + (p.seq (p.maybe (s.form (p.seq (s.form (p.after (s.this (' handle)) handle-args)) + s.any))) + (p.maybe (s.form (p.seq (s.form (p.after (s.this (' stop)) stop-args)) + s.any)))))) + +(syntax: #export (actor: [export csr.export] [[_name _vars] actor-decl^] - [annotations (p;default cs;empty-annotations csr;annotations)] + [annotations (p.default cs.empty-annotations csr.annotations)] state-type [[?handle ?stop] behavior^]) - {#;doc (doc "Defines an actor, with its behavior and internal state." + {#.doc (doc "Defines an actor, with its behavior and internal state." (actor: #export Counter Nat ((stop cause state) - (:: P;Monad<Promise> wrap - (log! (if (ex;match? ;;Killed cause) + (:: P.Monad<Promise> wrap + (log! (if (ex.match? ..Killed cause) (format "Counter was killed: " (%n state)) cause))))) @@ -216,54 +216,54 @@ (List a) ((handle message state self) - (do T;Monad<Task> + (do T.Monad<Task> [#let [_ (log! "BEFORE")] output (message state self) #let [_ (log! "AFTER")]] (wrap output)))))} (with-gensyms [g!message g!self g!state g!init g!error g!return g!output] (do @ - [module macro;current-module-name - #let [g!type (code;local-symbol (state-name _name)) - g!behavior (code;local-symbol (behavior-name _name)) - g!actor (code;local-symbol _name) - g!new (code;local-symbol (new-name _name)) - g!vars (list/map code;local-symbol _vars)]] - (wrap (list (` (type: (~@ (csw;export export)) ((~ g!type) (~@ g!vars)) + [module macro.current-module-name + #let [g!type (code.local-symbol (state-name _name)) + g!behavior (code.local-symbol (behavior-name _name)) + g!actor (code.local-symbol _name) + g!new (code.local-symbol (new-name _name)) + g!vars (list/map code.local-symbol _vars)]] + (wrap (list (` (type: (~@ (csw.export export)) ((~ g!type) (~@ g!vars)) (~ state-type))) - (` (type: (~@ (csw;export export)) ((~ g!actor) (~@ g!vars)) + (` (type: (~@ (csw.export export)) ((~ g!actor) (~@ g!vars)) (~ (|> annotations (with-actor [module _name]) - csw;annotations)) - (;;Actor ((~ g!type) (~@ g!vars))))) - (` (def: (~@ (csw;export export)) (~ g!behavior) + csw.annotations)) + (..Actor ((~ g!type) (~@ g!vars))))) + (` (def: (~@ (csw.export export)) (~ g!behavior) (All [(~@ g!vars)] - (;;Behavior ((~ g!type) (~@ g!vars)))) - {#;;handle (~ (case ?handle - #;None - (` ;;default-handle) - - (#;Some [[messageN stateN selfN] bodyC]) - (` (function [(~ (code;local-symbol messageN)) - (~ (code;local-symbol stateN)) - (~ (code;local-symbol selfN))] - (do T;Monad<Task> + (..Behavior ((~ g!type) (~@ g!vars)))) + {#..handle (~ (case ?handle + #.None + (` ..default-handle) + + (#.Some [[messageN stateN selfN] bodyC]) + (` (function [(~ (code.local-symbol messageN)) + (~ (code.local-symbol stateN)) + (~ (code.local-symbol selfN))] + (do T.Monad<Task> [] (~ bodyC)))))) - #;;end (~ (case ?stop - #;None - (` ;;default-end) - - (#;Some [[causeN stateN] bodyC]) - (` (function [(~ (code;local-symbol causeN)) - (~ (code;local-symbol stateN))] - (do P;Monad<Promise> + #..end (~ (case ?stop + #.None + (` ..default-end) + + (#.Some [[causeN stateN] bodyC]) + (` (function [(~ (code.local-symbol causeN)) + (~ (code.local-symbol stateN))] + (do P.Monad<Promise> [] (~ bodyC))))))})) - (` (def: (~@ (csw;export export)) ((~ g!new) (~ g!init)) + (` (def: (~@ (csw.export export)) ((~ g!new) (~ g!init)) (All [(~@ g!vars)] - (-> ((~ g!type) (~@ g!vars)) (io;IO ((~ g!actor) (~@ g!vars))))) - (;;spawn (~ g!behavior) (~ g!init)))))) + (-> ((~ g!type) (~@ g!vars)) (io.IO ((~ g!actor) (~@ g!vars))))) + (..spawn (~ g!behavior) (~ g!init)))))) ))) (type: Signature @@ -275,25 +275,25 @@ #output Code}) (def: signature^ - (s;Syntax Signature) - (s;form ($_ p;seq - (p;default (list) (s;tuple (p;some s;local-symbol))) - s;local-symbol - (p;some csr;typed-input) - s;local-symbol - s;local-symbol - s;any))) + (s.Syntax Signature) + (s.form ($_ p.seq + (p.default (list) (s.tuple (p.some s.local-symbol))) + s.local-symbol + (p.some csr.typed-input) + s.local-symbol + s.local-symbol + s.any))) (def: reference^ - (s;Syntax [Ident (List Text)]) - (p;either (s;form (p;seq s;symbol (p;some s;local-symbol))) - (p;seq s;symbol (:: p;Monad<Parser> wrap (list))))) + (s.Syntax [Ident (List Text)]) + (p.either (s.form (p.seq s.symbol (p.some s.local-symbol))) + (p.seq s.symbol (:: p.Monad<Parser> wrap (list))))) -(syntax: #export (message: [export csr;export] [[actor-name actor-vars] reference^] +(syntax: #export (message: [export csr.export] [[actor-name actor-vars] reference^] [signature signature^] - [annotations (p;default cs;empty-annotations csr;annotations)] + [annotations (p.default cs.empty-annotations csr.annotations)] body) - {#;doc (doc "A message can access the actor's state through the state parameter." + {#.doc (doc "A message can access the actor's state through the state parameter." "A message can also access the actor itself through the self parameter." "A message's output must be a task containing a 2-tuple with the updated state and a return value." "A message may succeed or fail (in case of failure, the actor dies)." @@ -301,66 +301,66 @@ (message: #export Counter (count! [increment Nat] state self Nat) (let [state' (n/+ increment state)] - (T;return [state' state']))) + (T.return [state' state']))) (message: #export (Stack a) (push [value a] state self (List a)) - (let [state' (#;Cons value state)] - (T;return [state' state']))))} + (let [state' (#.Cons value state)] + (T.return [state' state']))))} (with-gensyms [g!return g!error g!task g!sent?] (do @ [actor-name (resolve-actor actor-name) - #let [g!type (code;symbol (product;both id state-name actor-name)) - g!message (code;local-symbol (get@ #name signature)) - g!actor-vars (list/map code;local-symbol actor-vars) - g!actor (` ((~ (code;symbol actor-name)) (~@ g!actor-vars))) - g!all-vars (|> (get@ #vars signature) (list/map code;local-symbol) (list/compose g!actor-vars)) - g!inputsC (|> (get@ #inputs signature) (list/map (|>> product;left code;local-symbol))) - g!inputsT (|> (get@ #inputs signature) (list/map product;right)) - g!state (|> signature (get@ #state) code;local-symbol) - g!self (|> signature (get@ #self) code;local-symbol) + #let [g!type (code.symbol (product.both id state-name actor-name)) + g!message (code.local-symbol (get@ #name signature)) + g!actor-vars (list/map code.local-symbol actor-vars) + g!actor (` ((~ (code.symbol actor-name)) (~@ g!actor-vars))) + g!all-vars (|> (get@ #vars signature) (list/map code.local-symbol) (list/compose g!actor-vars)) + g!inputsC (|> (get@ #inputs signature) (list/map (|>> product.left code.local-symbol))) + g!inputsT (|> (get@ #inputs signature) (list/map product.right)) + g!state (|> signature (get@ #state) code.local-symbol) + g!self (|> signature (get@ #self) code.local-symbol) g!actor-refs (: (List Code) - (if (list;empty? actor-vars) + (if (list.empty? actor-vars) (list) - (|> actor-vars list;size n/dec - (list;n/range +0) (list/map (|>> code;nat (~) ($) (`)))))) - ref-replacements (|> (if (list;empty? actor-vars) + (|> actor-vars list.size n/dec + (list.n/range +0) (list/map (|>> code.nat (~) ($) (`)))))) + ref-replacements (|> (if (list.empty? actor-vars) (list) - (|> actor-vars list;size n/dec - (list;n/range +0) (list/map (|>> code;nat (~) ($) (`))))) + (|> actor-vars list.size n/dec + (list.n/range +0) (list/map (|>> code.nat (~) ($) (`))))) (: (List Code)) - (list;zip2 g!all-vars) + (list.zip2 g!all-vars) (: (List [Code Code]))) g!outputT (list/fold (function [[g!var g!ref] outputT] - (code;replace g!var g!ref outputT)) + (code.replace g!var g!ref outputT)) (get@ #output signature) ref-replacements)]] - (wrap (list (` (def: (~@ (csw;export export)) ((~ g!message) (~@ g!inputsC) (~ g!self)) + (wrap (list (` (def: (~@ (csw.export export)) ((~ g!message) (~@ g!inputsC) (~ g!self)) (~ (|> annotations (with-message actor-name) - csw;annotations)) - (All [(~@ g!all-vars)] (-> (~@ g!inputsT) (~ g!actor) (T;Task (~ (get@ #output signature))))) - (let [(~ g!task) (T;task (~ g!outputT))] - (io;run (do io;Monad<IO> - [(~ g!sent?) (;;send (function [(~ g!state) (~ g!self)] - (do P;Monad<Promise> - [(~ g!return) (: (T;Task [((~ g!type) (~@ g!actor-refs)) + csw.annotations)) + (All [(~@ g!all-vars)] (-> (~@ g!inputsT) (~ g!actor) (T.Task (~ (get@ #output signature))))) + (let [(~ g!task) (T.task (~ g!outputT))] + (io.run (do io.Monad<IO> + [(~ g!sent?) (..send (function [(~ g!state) (~ g!self)] + (do P.Monad<Promise> + [(~ g!return) (: (T.Task [((~ g!type) (~@ g!actor-refs)) (~ g!outputT)]) - (do T;Monad<Task> + (do T.Monad<Task> [] (~ body)))] (case (~ g!return) - (#;Right [(~ g!state) (~ g!return)]) - (exec (io;run (P;resolve (#;Right (~ g!return)) (~ g!task))) - (T;return (~ g!state))) + (#.Right [(~ g!state) (~ g!return)]) + (exec (io.run (P.resolve (#.Right (~ g!return)) (~ g!task))) + (T.return (~ g!state))) - (#;Left (~ g!error)) - (exec (io;run (P;resolve (#;Left (~ g!error)) (~ g!task))) - (T;fail (~ g!error)))) + (#.Left (~ g!error)) + (exec (io.run (P.resolve (#.Left (~ g!error)) (~ g!task))) + (T.fail (~ g!error)))) )) (~ g!self))] (if (~ g!sent?) ((~' wrap) (~ g!task)) - ((~' wrap) (T;throw ;;Dead "")))))))) + ((~' wrap) (T.throw ..Dead "")))))))) )) ))) diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index f2e1cc14e..bd3041979 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -1,11 +1,11 @@ -(;module: +(.module: lux (lux [function] [io #- run])) (type: #export (Atom a) - {#;doc "Atomic references that are safe to mutate concurrently."} - (#;Primitive "#Atom" (#;Cons a #;Nil))) + {#.doc "Atomic references that are safe to mutate concurrently."} + (#.Primitive "#Atom" (#.Cons a #.Nil))) (def: #export (atom value) (All [a] (-> a (Atom a))) @@ -16,14 +16,14 @@ (io ("lux atom read" atom))) (def: #export (compare-and-swap current new atom) - {#;doc "Only mutates an atom if you can present it's current value. + {#.doc "Only mutates an atom if you can present it's current value. That guarantees that atom was not updated since you last read from it."} (All [a] (-> a a (Atom a) (IO Bool))) (io ("lux atom compare-and-swap" atom current new))) (def: #export (update f atom) - {#;doc "Updates an atom by applying a function to its current value. + {#.doc "Updates an atom by applying a function to its current value. If it fails to update it (because some other process wrote to it first), it will retry until it succeeds. @@ -32,8 +32,8 @@ (io (let [old ("lux atom read" atom)] (if ("lux atom compare-and-swap" atom old (f old)) [] - (io;run (update f atom)))))) + (io.run (update f atom)))))) (def: #export (write value atom) (All [a] (-> a (Atom a) (IO Unit))) - (update (function;const value) atom)) + (update (function.const value) atom)) diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index ba438fcf4..541b6530a 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] ["A" applicative] @@ -14,283 +14,283 @@ ## [Types] (type: #export (Channel a) - {#;doc "An asynchronous channel of values which may be closed. + {#.doc "An asynchronous channel of values which may be closed. Reading from a channel does not remove the read piece of data, as it can still be accessed if you have an earlier node of the channel."} - (&;Promise (Maybe [a (Channel a)]))) + (&.Promise (Maybe [a (Channel a)]))) ## [Syntax] -(syntax: #export (channel [type s;any]) - {#;doc (doc "Makes an uninitialized Channel (in this case, of Nat)." +(syntax: #export (channel [type s.any]) + {#.doc (doc "Makes an uninitialized Channel (in this case, of Nat)." (channel Nat))} (wrap (list (` (: (Channel (~ type)) - (&;promise' #;None)))))) + (&.promise' #.None)))))) ## [Values] (def: #export (filter p xs) (All [a] (-> (-> a Bool) (Channel a) (Channel a))) - (do &;Monad<Promise> + (do &.Monad<Promise> [?x+xs xs] (case ?x+xs - #;None (wrap #;None) - (#;Some [x xs']) (if (p x) - (wrap (#;Some [x (filter p xs')])) + #.None (wrap #.None) + (#.Some [x xs']) (if (p x) + (wrap (#.Some [x (filter p xs')])) (filter p xs'))))) (def: #export (write value target) - {#;doc "Write to a channel, so long as it's still open."} + {#.doc "Write to a channel, so long as it's still open."} (All [a] (-> a (Channel a) (IO (Maybe (Channel a))))) - (case (&;poll target) + (case (&.poll target) (^template [<case> <channel-to-write>] <case> (do Monad<IO> [#let [new-tail (channel ($ +0))] - done? (&;resolve (#;Some [value new-tail]) <channel-to-write>)] + done? (&.resolve (#.Some [value new-tail]) <channel-to-write>)] (if done? - (wrap (#;Some new-tail)) + (wrap (#.Some new-tail)) (write value <channel-to-write>)))) - ([#;None target] - [(#;Some (#;Some [_ target'])) target']) + ([#.None target] + [(#.Some (#.Some [_ target'])) target']) _ - (:: Monad<IO> wrap #;None) + (:: Monad<IO> wrap #.None) )) (def: #export (close target) (All [a] (-> (Channel a) (IO Bool))) - (case (&;poll target) + (case (&.poll target) (^template [<case> <channel-to-write>] <case> (do Monad<IO> - [done? (&;resolve #;None <channel-to-write>)] + [done? (&.resolve #.None <channel-to-write>)] (if done? (wrap true) (close <channel-to-write>)))) - ([#;None target] - [(#;Some (#;Some [_ target'])) target']) + ([#.None target] + [(#.Some (#.Some [_ target'])) target']) _ (:: Monad<IO> wrap false) )) (def: (pipe' input output) - (All [a] (-> (Channel a) (Channel a) (&;Promise Unit))) - (do &;Monad<Promise> + (All [a] (-> (Channel a) (Channel a) (&.Promise Unit))) + (do &.Monad<Promise> [?x+xs input] (case ?x+xs - #;None (wrap []) - (#;Some [x input']) (case (io;run (write x output)) - #;None + #.None (wrap []) + (#.Some [x input']) (case (io.run (write x output)) + #.None (wrap []) - (#;Some output') + (#.Some output') (pipe' input' output'))))) (def: #export (pipe input output) - {#;doc "Copy/pipe the contents of a channel on to another."} - (All [a] (-> (Channel a) (Channel a) (&;Promise Unit))) - (do &;Monad<Promise> + {#.doc "Copy/pipe the contents of a channel on to another."} + (All [a] (-> (Channel a) (Channel a) (&.Promise Unit))) + (do &.Monad<Promise> [_ (pipe' input output)] - (exec (io;run (close output)) + (exec (io.run (close output)) (wrap [])))) (def: #export (merge xss) - {#;doc "Fuse all the elements in a list of channels by piping them onto a new output channel."} + {#.doc "Fuse all the elements in a list of channels by piping them onto a new output channel."} (All [a] (-> (List (Channel a)) (Channel a))) (let [output (channel ($ +0))] - (exec (do &;Monad<Promise> - [_ (M;map @ (function [input] (pipe' input output)) xss)] - (exec (io;run (close output)) + (exec (do &.Monad<Promise> + [_ (M.map @ (function [input] (pipe' input output)) xss)] + (exec (io.run (close output)) (wrap []))) output))) (def: #export (fold f init xs) - {#;doc "Asynchronous fold over channels."} - (All [a b] (-> (-> b a (&;Promise a)) a (Channel b) (&;Promise a))) - (do &;Monad<Promise> + {#.doc "Asynchronous fold over channels."} + (All [a b] (-> (-> b a (&.Promise a)) a (Channel b) (&.Promise a))) + (do &.Monad<Promise> [?x+xs xs] (case ?x+xs - #;None (wrap init) - (#;Some [x xs']) (do @ + #.None (wrap init) + (#.Some [x xs']) (do @ [init' (f x init)] (fold f init' xs'))))) (def: #export (folds f init xs) - {#;doc "A channel of folds."} - (All [a b] (-> (-> b a (&;Promise a)) a (Channel b) (Channel a))) - (do &;Monad<Promise> + {#.doc "A channel of folds."} + (All [a b] (-> (-> b a (&.Promise a)) a (Channel b) (Channel a))) + (do &.Monad<Promise> [?x+xs xs] (case ?x+xs - #;None (wrap (#;Some [init (wrap #;None)])) - (#;Some [x xs']) (do @ + #.None (wrap (#.Some [init (wrap #.None)])) + (#.Some [x xs']) (do @ [init' (f x init)] (folds f init' xs'))))) (def: (distinct' eq last-one xs) (All [a] (-> (Eq a) a (Channel a) (Channel a))) (let [(^open) eq] - (do &;Monad<Promise> + (do &.Monad<Promise> [?x+xs xs] (case ?x+xs - #;None (wrap #;None) - (#;Some [x xs']) (if (= x last-one) + #.None (wrap #.None) + (#.Some [x xs']) (if (= x last-one) (distinct' eq last-one xs') - (wrap (#;Some [x (distinct' eq x xs')]))))))) + (wrap (#.Some [x (distinct' eq x xs')]))))))) (def: #export (distinct eq xs) - {#;doc "Multiple consecutive equal values in the input channel will just be single value in the output channel."} + {#.doc "Multiple consecutive equal values in the input channel will just be single value in the output channel."} (All [a] (-> (Eq a) (Channel a) (Channel a))) (let [(^open) eq] - (do &;Monad<Promise> + (do &.Monad<Promise> [?x+xs xs] (case ?x+xs - #;None (wrap #;None) - (#;Some [x xs']) (wrap (#;Some [x (distinct' eq x xs')])))))) + #.None (wrap #.None) + (#.Some [x xs']) (wrap (#.Some [x (distinct' eq x xs')])))))) (def: #export (consume xs) - {#;doc "Reads the entirety of a channel's contents and returns them as a list."} - (All [a] (-> (Channel a) (&;Promise (List a)))) - (do &;Monad<Promise> + {#.doc "Reads the entirety of a channel's contents and returns them as a list."} + (All [a] (-> (Channel a) (&.Promise (List a)))) + (do &.Monad<Promise> [?x+xs' xs] (case ?x+xs' - #;None - (wrap #;Nil) + #.None + (wrap #.Nil) - (#;Some [x xs']) + (#.Some [x xs']) (do @ [=xs (consume xs')] - (wrap (#;Cons x =xs)))))) + (wrap (#.Cons x =xs)))))) (def: #export (once p) - (All [a] (-> (&;Promise a) (Channel a))) - (do &;Monad<Promise> + (All [a] (-> (&.Promise a) (Channel a))) + (do &.Monad<Promise> [x p] - (wrap (#;Some [x (wrap #;None)])))) + (wrap (#.Some [x (wrap #.None)])))) (def: #export (poll time action) (All [a] (-> Nat (IO (Maybe a)) (Channel a))) - (do &;Monad<Promise> - [?output (&;future action)] + (do &.Monad<Promise> + [?output (&.future action)] (case ?output - #;None - (wrap #;None) + #.None + (wrap #.None) - (#;Some head) + (#.Some head) (do @ - [_ (&;wait time)] - (wrap (#;Some [head (poll time action)])))))) + [_ (&.wait time)] + (wrap (#.Some [head (poll time action)])))))) (def: #export (periodic time value) (All [a] (-> Nat a (Channel a))) - (do &;Monad<Promise> + (do &.Monad<Promise> [] - (wrap (#;Some [value (do @ - [_ (&;wait time)] + (wrap (#.Some [value (do @ + [_ (&.wait time)] (periodic time value))])))) (def: #export (sequential time xs) (All [a] (-> Nat (List a) (Channel a))) - (do &;Monad<Promise> + (do &.Monad<Promise> [] (case xs - #;Nil - (wrap #;None) + #.Nil + (wrap #.None) - (#;Cons x xs') - (wrap (#;Some [x (do @ - [_ (&;wait time)] + (#.Cons x xs') + (wrap (#.Some [x (do @ + [_ (&.wait time)] (sequential time xs'))]))))) (def: #export (cycle time values) (All [a] (-> Nat (List a) (Channel a))) - (do &;Monad<Promise> + (do &.Monad<Promise> [] (case values - #;Nil - (wrap #;None) + #.Nil + (wrap #.None) _ (loop [xs values] (case xs - #;Nil + #.Nil (recur values) - (#;Cons x xs') - (wrap (#;Some [x (do @ - [_ (&;wait time)] + (#.Cons x xs') + (wrap (#.Some [x (do @ + [_ (&.wait time)] (recur xs'))]))))))) ## Utils (def: (tail xs) (All [a] (-> (List a) (List a))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons _ xs') + (#.Cons _ xs') xs')) (def: #export (sliding-window max inputs) (All [a] (-> Nat (Channel a) (Channel (List a)))) - (let [(^open) &;Monad<Promise>] + (let [(^open) &.Monad<Promise>] (folds (function [input window] (let [window' (L/compose window (list input))] - (wrap (if (n/<= max (list;size window')) + (wrap (if (n/<= max (list.size window')) window' (tail window'))))) (list) inputs))) (def: #export (iterate f init) - (All [a] (-> (-> a (&;Promise (Maybe a))) a (Channel a))) - (do &;Monad<Promise> + (All [a] (-> (-> a (&.Promise (Maybe a))) a (Channel a))) + (do &.Monad<Promise> [] - (wrap (#;Some [init (do @ + (wrap (#.Some [init (do @ [?next (f init)] (case ?next - #;None - (wrap #;None) + #.None + (wrap #.None) - (#;Some init') + (#.Some init') (iterate f init')))])))) (def: #export (sample time inputs) (All [a] (-> Nat (Channel a) (Channel a))) - (do &;Monad<Promise> + (do &.Monad<Promise> [?h+t inputs] (case ?h+t - #;None - (wrap #;None) + #.None + (wrap #.None) - (#;Some [value inputs']) + (#.Some [value inputs']) (do @ - [_ (&;wait time) + [_ (&.wait time) #let [next-inputs (loop [last-resolved-node inputs'] - (case (&;poll last-resolved-node) - (^multi (#;Some (#;Some [_ next-node])) - (&;resolved? next-node)) + (case (&.poll last-resolved-node) + (^multi (#.Some (#.Some [_ next-node])) + (&.resolved? next-node)) (recur next-node) _ last-resolved-node))]] - (wrap (#;Some [value (sample time next-inputs)])))))) + (wrap (#.Some [value (sample time next-inputs)])))))) ## [Structures] -(struct: #export _ (F;Functor Channel) +(struct: #export _ (F.Functor Channel) (def: (map f xs) - (:: &;Functor<Promise> map + (:: &.Functor<Promise> map (function [?x+xs] (case ?x+xs - #;None #;None - (#;Some [x xs']) (#;Some [(f x) (map f xs')]))) + #.None #.None + (#.Some [x xs']) (#.Some [(f x) (map f xs')]))) xs))) -(struct: #export _ (A;Applicative Channel) +(struct: #export _ (A.Applicative Channel) (def: functor Functor<Channel>) (def: (wrap a) - (let [(^open) &;Monad<Promise>] - (wrap (#;Some [a (wrap #;None)])))) + (let [(^open) &.Monad<Promise>] + (wrap (#.Some [a (wrap #.None)])))) (def: (apply ff fa) (let [fb (channel ($ +1))] diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 9984ad96a..0762694f9 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data (coll [list #* "" Functor<List>]) number @@ -11,8 +11,7 @@ ["p" parser]) [macro] (macro ["s" syntax #+ syntax: Syntax]) - (concurrency [atom #+ Atom atom]) - )) + (concurrency [atom #+ Atom atom]))) (def: #export concurrency-level Nat @@ -23,7 +22,7 @@ #observers (List (-> a (IO Top)))}) (type: #export (Promise a) - {#;doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."} + {#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."} (Atom (Promise-State a))) (def: #hidden (promise' ?value) @@ -31,81 +30,81 @@ (atom {#value ?value #observers (list)})) -(syntax: #export (promise [type s;any]) - {#;doc (doc "Makes an uninitialized Promise (in this example, of Unit)." +(syntax: #export (promise [type s.any]) + {#.doc (doc "Makes an uninitialized Promise (in this example, of Unit)." (promise Unit))} (wrap (list (` (: (Promise (~ type)) - (promise' #;None)))))) + (promise' #.None)))))) (def: #export (poll promise) - {#;doc "Polls a Promise's value."} + {#.doc "Polls a Promise's value."} (All [a] (-> (Promise a) (Maybe a))) - (|> (atom;read promise) - io;run + (|> (atom.read promise) + io.run (get@ #value))) (def: #export (resolved? promise) - {#;doc "Checks whether a Promise's value has already been resolved."} + {#.doc "Checks whether a Promise's value has already been resolved."} (All [a] (-> (Promise a) Bool)) (case (poll promise) - #;None + #.None false - (#;Some _) + (#.Some _) true)) (def: #export (resolve value promise) - {#;doc "Sets an Promise's value if it has not been done yet."} + {#.doc "Sets an Promise's value if it has not been done yet."} (All [a] (-> a (Promise a) (IO Bool))) (do Monad<IO> - [old (atom;read promise)] + [old (atom.read promise)] (case (get@ #value old) - (#;Some _) + (#.Some _) (wrap false) - #;None + #.None (do @ - [#let [new (set@ #value (#;Some value) old)] - succeeded? (atom;compare-and-swap old new promise)] + [#let [new (set@ #value (#.Some value) old)] + succeeded? (atom.compare-and-swap old new promise)] (if succeeded? (do @ - [_ (M;map @ (function [f] (f value)) + [_ (M.map @ (function [f] (f value)) (get@ #observers old))] (wrap true)) (resolve value promise)))))) (def: #export (await f promise) (All [a] (-> (-> a (IO Top)) (Promise a) Top)) - (let [old (io;run (atom;read promise))] + (let [old (io.run (atom.read promise))] (case (get@ #value old) - (#;Some value) - (io;run (f value)) + (#.Some value) + (io.run (f value)) - #;None - (let [new (update@ #observers (|>> (#;Cons f)) old)] - (if (io;run (atom;compare-and-swap old new promise)) + #.None + (let [new (update@ #observers (|>> (#.Cons f)) old)] + (if (io.run (atom.compare-and-swap old new promise)) [] (await f promise)))))) -(struct: #export _ (F;Functor Promise) +(struct: #export _ (F.Functor Promise) (def: (map f fa) (let [fb (promise ($ +1)) - ## fb (promise' #;None) + ## fb (promise' #.None) ] (exec (await (function [a] (resolve (f a) fb)) fa) fb)))) -(struct: #export _ (A;Applicative Promise) +(struct: #export _ (A.Applicative Promise) (def: functor Functor<Promise>) (def: (wrap a) - (atom {#value (#;Some a) + (atom {#value (#.Some a) #observers (list)})) (def: (apply ff fa) (let [fb (promise ($ +1)) - ## fb (promise' #;None) + ## fb (promise' #.None) ] (exec (await (function [f] (io (await (function [a] (resolve (f a) fb)) @@ -119,7 +118,7 @@ (def: (join mma) (let [ma (promise ($ +0)) - ## ma (promise' #;None) + ## ma (promise' #.None) ] (exec (await (function [ma'] (io (await (function [a'] (resolve a' ma)) @@ -128,7 +127,7 @@ ma)))) (def: #export (seq left right) - {#;doc "Sequencing combinator."} + {#.doc "Sequencing combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise [a b]))) (do Monad<Promise> [a left @@ -136,27 +135,27 @@ (wrap [a b]))) (def: #export (alt left right) - {#;doc "Heterogeneous alternative combinator."} + {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) (let [a|b (promise (| ($ +0) ($ +1))) - ## a|b (promise' #;None) + ## a|b (promise' #.None) ] (with-expansions [<sides> (do-template [<promise> <tag>] [(await (function [value] (resolve (<tag> value) a|b)) <promise>)] - [left #;Left] - [right #;Right] + [left #.Left] + [right #.Right] )] (exec <sides> a|b)))) (def: #export (either left right) - {#;doc "Homogeneous alternative combinator."} + {#.doc "Homogeneous alternative combinator."} (All [a] (-> (Promise a) (Promise a) (Promise a))) (let [left||right (promise ($ +0)) - ## left||right (promise' #;None) + ## left||right (promise' #.None) ] (`` (exec (~~ (do-template [<promise>] [(await (function [value] (resolve value left||right)) @@ -167,28 +166,28 @@ left||right)))) (def: #export (future computation) - {#;doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."} + {#.doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."} (All [a] (-> (IO a) (Promise a))) (let [!out (promise ($ +0)) - ## !out (promise' #;None) + ## !out (promise' #.None) ] - (exec ("lux process future" (io (io;run (resolve (io;run computation) + (exec ("lux process future" (io (io.run (resolve (io.run computation) !out)))) !out))) (def: #export (wait time) - {#;doc "Returns a Promise that will be resolved after the specified amount of milliseconds."} + {#.doc "Returns a Promise that will be resolved after the specified amount of milliseconds."} (-> Nat (Promise Unit)) (let [!out (promise Unit)] (exec ("lux process schedule" time (resolve [] !out)) !out))) (def: #export (time-out time promise) - {#;doc "Wait for a Promise to be resolved within the specified amount of milliseconds."} + {#.doc "Wait for a Promise to be resolved within the specified amount of milliseconds."} (All [a] (-> Nat (Promise a) (Promise (Maybe a)))) (alt (wait time) promise)) (def: #export (delay time value) - {#;doc "Delivers a value after a certain period has passed."} + {#.doc "Delivers a value after a certain period has passed."} (All [a] (-> Nat a (Promise a))) (:: Functor<Promise> map (const value) (wait time))) diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux index 091cae7fc..1ba795b24 100644 --- a/stdlib/source/lux/concurrency/space.lux +++ b/stdlib/source/lux/concurrency/space.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["ex" exception #+ exception:] @@ -17,10 +17,10 @@ ["csw" writer]))))) (with-expansions - [<Event> [e (A;Actor Top) (Space e)] - <Action> (as-is (-> <Event> (A;Actor s) (T;Task Bool)))] + [<Event> [e (A.Actor Top) (Space e)] + <Action> (as-is (-> <Event> (A.Actor s) (T.Task Bool)))] (type: #export (Space e) - (A;Actor (List (Ex [s] [(A;Actor s) <Action>])))) + (A.Actor (List (Ex [s] [(A.Actor s) <Action>])))) (type: #export (Event e) <Event>) @@ -31,43 +31,43 @@ (exception: #export Closed-Space) (def: (send-space message space) - (All [s] (-> (A;Message s) (A;Actor s) (T;Task Unit))) - (P;future (do Monad<IO> - [success? (A;send message space)] + (All [s] (-> (A.Message s) (A.Actor s) (T.Task Unit))) + (P.future (do Monad<IO> + [success? (A.send message space)] (wrap (if success? - (ex;return []) - (ex;throw Closed-Space "")))))) + (ex.return []) + (ex.throw Closed-Space "")))))) (def: #export (subscribe actor action space) - (All [e s] (-> (A;Actor s) (Action e s) (Space e) (T;Task Unit))) + (All [e s] (-> (A.Actor s) (Action e s) (Space e) (T.Task Unit))) (send-space (function [subscriptions _] - (T;return (|> subscriptions - (list;filter (|>> product;left (:! []) (is (:! [] actor)) not)) - (#;Cons [actor action])))) + (T.return (|> subscriptions + (list.filter (|>> product.left (:! []) (is (:! [] actor)) not)) + (#.Cons [actor action])))) space)) (def: #export (un-subscribe actor space) - (All [e s] (-> (A;Actor s) (Space e) (T;Task Unit))) + (All [e s] (-> (A.Actor s) (Space e) (T.Task Unit))) (send-space (function [subscriptions _] - (T;return (|> subscriptions - (list;filter (|>> product;left (:! []) (is (:! [] actor)) not))))) + (T.return (|> subscriptions + (list.filter (|>> product.left (:! []) (is (:! [] actor)) not))))) space)) (def: #export (emit event space sender) - (All [e s] (-> e (Space e) (A;Actor s) (T;Task Unit))) + (All [e s] (-> e (Space e) (A.Actor s) (T.Task Unit))) (send-space (function [subscriptions _] - (exec (do T;Monad<Task> - [verdicts (monad;map @ + (exec (do T.Monad<Task> + [verdicts (monad.map @ (function [(^@ sub [receiver action])] (if (is (:! [] receiver) (:! [] sender)) - (T;return [true sub]) + (T.return [true sub]) (do @ [sent? (action [event sender space] receiver)] (wrap [sent? sub])))) subscriptions)] - (T;return (L/fold (function [[sent? sub] survivors] + (T.return (L/fold (function [[sent? sub] survivors] (if sent? - (#;Cons sub survivors) + (#.Cons sub survivors) survivors)) (list) verdicts))))) @@ -75,7 +75,7 @@ (def: #export space (All [e] (IO (Space e))) - (A;spawn A;default-behavior (list))) + (A.spawn A.default-behavior (list))) (type: ActionS {#action-name Text @@ -86,35 +86,35 @@ #receiver-name Text}) (def: reference^ - (s;Syntax [Ident (List Code)]) - (p;either (s;form (p;seq s;symbol (p;some s;any))) - (p;seq s;symbol (:: p;Monad<Parser> wrap (list))))) + (s.Syntax [Ident (List Code)]) + (p.either (s.form (p.seq s.symbol (p.some s.any))) + (p.seq s.symbol (:: p.Monad<Parser> wrap (list))))) (def: action^ - (s;Syntax ActionS) - (s;form ($_ p;seq - s;local-symbol - s;local-symbol - s;local-symbol - s;any - s;any - s;local-symbol))) + (s.Syntax ActionS) + (s.form ($_ p.seq + s.local-symbol + s.local-symbol + s.local-symbol + s.any + s.any + s.local-symbol))) (def: type-vars^ - (s;Syntax (List Text)) - (p;either (s;tuple (p;some s;local-symbol)) - (:: p;Monad<Parser> wrap (list)))) + (s.Syntax (List Text)) + (p.either (s.tuple (p.some s.local-symbol)) + (:: p.Monad<Parser> wrap (list)))) -(def: #hidden _future P;future) +(def: #hidden _future P.future) -(syntax: #export (on: [export csr;export] +(syntax: #export (on: [export csr.export] [t-vars type-vars^] [[actor-name actor-params] reference^] eventT [declaration action^] - [annotations (p;default cs;empty-annotations csr;annotations)] + [annotations (p.default cs.empty-annotations csr.annotations)] body) - {#;doc (doc (type: Move + {#.doc (doc (type: Move #Ping #Pong) @@ -124,31 +124,31 @@ (on: #export Move (counter move space hits self) (do @ [_ (emit (case move - #;Ping #;Pong - #;Pong #;Ping) + #.Ping #.Pong + #.Pong #.Ping) space self)] (wrap (n/inc hits)))))} (with-gensyms [g!_] (do @ - [actor-name (A;resolve-actor actor-name) - #let [stateT (` ((~ (code;symbol (product;both id A;state-name actor-name))) + [actor-name (A.resolve-actor actor-name) + #let [stateT (` ((~ (code.symbol (product.both id A.state-name actor-name))) (~@ actor-params))) - g!actionL (code;local-symbol (get@ #action-name declaration)) - g!senderL (code;local-symbol (get@ #sender-name declaration)) - g!spaceL (code;local-symbol (get@ #space-name declaration)) - g!receiverL (code;local-symbol (get@ #receiver-name declaration)) + g!actionL (code.local-symbol (get@ #action-name declaration)) + g!senderL (code.local-symbol (get@ #sender-name declaration)) + g!spaceL (code.local-symbol (get@ #space-name declaration)) + g!receiverL (code.local-symbol (get@ #receiver-name declaration)) g!event (get@ #event declaration) g!state (get@ #state declaration)]] - (wrap (list (` (def: (~@ (csw;export export)) ((~ g!actionL) [(~ g!event) (~ g!senderL) (~ g!spaceL)] (~ g!receiverL)) - (~ (csw;annotations annotations)) - (All [(~@ (L/map code;local-symbol t-vars))] - (;;Action (~ eventT) (~ stateT))) - (T;from-promise + (wrap (list (` (def: (~@ (csw.export export)) ((~ g!actionL) [(~ g!event) (~ g!senderL) (~ g!spaceL)] (~ g!receiverL)) + (~ (csw.annotations annotations)) + (All [(~@ (L/map code.local-symbol t-vars))] + (..Action (~ eventT) (~ stateT))) + (T.from-promise (_future - (A;send (function [(~ g!state) (~ g!receiverL)] - (: (T;Task (~ stateT)) - (monad;do T;Monad<Task> + (A.send (function [(~ g!state) (~ g!receiverL)] + (: (T.Task (~ stateT)) + (monad.do T.Monad<Task> [] (~ body)))) (~ g!receiverL)))) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 4aaee3580..f7c7664f1 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -24,7 +24,7 @@ #observers (Dict Text (-> a (IO Unit)))}) (type: #export (Var a) - {#;doc "A mutable cell containing a value, and observers that will be alerted of any change to it."} + {#.doc "A mutable cell containing a value, and observers that will be alerted of any change to it."} (Atom (Var-State a))) (type: (Tx-Frame a) @@ -36,23 +36,23 @@ (List (Ex [a] (Tx-Frame a)))) (type: #export (STM a) - {#;doc "A computation which updates a transaction and produces a value."} + {#.doc "A computation which updates a transaction and produces a value."} (-> Tx [Tx a])) (def: #export (var value) - {#;doc "Creates a new STM var, with a default value."} + {#.doc "Creates a new STM var, with a default value."} (All [a] (-> a (Var a))) - (atom;atom {#value value - #observers (dict;new text;Hash<Text>)})) + (atom.atom {#value value + #observers (dict.new text.Hash<Text>)})) (def: raw-read (All [a] (-> (Var a) a)) - (|>> atom;read io;run (get@ #value))) + (|>> atom.read io.run (get@ #value))) (def: (find-var-value var tx) (All [a] (-> (Var a) Tx (Maybe a))) (|> tx - (list;find (function [[_var _original _current]] + (list.find (function [[_var _original _current]] (is (:! (Var Unit) var) (:! (Var Unit) _var)))) (:: Monad<Maybe> map (function [[_var _original _current]] @@ -63,35 +63,35 @@ (All [a] (-> (Var a) (STM a))) (function [tx] (case (find-var-value var tx) - (#;Some value) + (#.Some value) [tx value] - #;None + #.None (let [value (raw-read var)] - [(#;Cons [var value value] tx) + [(#.Cons [var value value] tx) value])))) (def: #export (read! var) - {#;doc "Reads var immediately, without going through a transaction."} + {#.doc "Reads var immediately, without going through a transaction."} (All [a] (-> (Var a) (IO a))) (|> var - atom;read + atom.read (:: Functor<IO> map (get@ #value)))) (def: (update-tx-value var value tx) (All [a] (-> (Var a) a Tx Tx)) (case tx - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [_var _original _current] tx') + (#.Cons [_var _original _current] tx') (if (is (:! (Var ($ +0)) var) (:! (Var ($ +0)) _var)) - (#;Cons [(:! (Var ($ +0)) _var) + (#.Cons [(:! (Var ($ +0)) _var) (:! ($ +0) _original) (:! ($ +0) value)] tx') - (#;Cons [_var _original _current] + (#.Cons [_var _original _current] (update-tx-value var value tx'))) )) @@ -99,59 +99,59 @@ (All [a] (-> a (Var a) (STM Unit))) (function [tx] (case (find-var-value var tx) - (#;Some _) + (#.Some _) [(update-tx-value var value tx) []] - #;None - [(#;Cons [var (raw-read var) value] tx) + #.None + [(#.Cons [var (raw-read var) value] tx) []]))) (def: #export (write! new-value var) - {#;doc "Writes value to var immediately, without going through a transaction."} + {#.doc "Writes value to var immediately, without going through a transaction."} (All [a] (-> a (Var a) (IO Unit))) (do Monad<IO> - [old (atom;read var) + [old (atom.read var) #let [old-value (get@ #value old) new (set@ #value new-value old)] - succeeded? (atom;compare-and-swap old new var)] + succeeded? (atom.compare-and-swap old new var)] (if succeeded? (do @ [_ (|> old (get@ #observers) - dict;values - (monad;map @ (function [f] (f new-value))))] + dict.values + (monad.map @ (function [f] (f new-value))))] (wrap [])) (write! new-value var)))) (def: #export (follow target) - {#;doc "Creates a channel that will receive all changes to the value of the given var."} - (All [a] (-> (Var a) (IO (frp;Channel a)))) - (let [head (frp;channel ($ +0)) + {#.doc "Creates a channel that will receive all changes to the value of the given var."} + (All [a] (-> (Var a) (IO (frp.Channel a)))) + (let [head (frp.channel ($ +0)) channel-var (var head) observer (function [label value] - (case (io;run (|> channel-var raw-read (frp;write value))) - #;None + (case (io.run (|> channel-var raw-read (frp.write value))) + #.None ## By closing the output Channel, the ## observer becomes obsolete. - (atom;update (function [[value observers]] - [value (dict;remove label observers)]) + (atom.update (function [[value observers]] + [value (dict.remove label observers)]) target) - (#;Some tail') + (#.Some tail') (write! tail' channel-var)))] (do Monad<IO> - [_ (atom;update (function [[value observers]] + [_ (atom.update (function [[value observers]] (let [label (nat/encode (list/fold (function [key base] (case (nat/decode key) - (#;Left _) + (#.Left _) base - (#;Right key-num) + (#.Right key-num) (n/max key-num base))) +0 - (dict;keys observers)))] - [value (dict;put label (observer label) observers)])) + (dict.keys observers)))] + [value (dict.put label (observer label) observers)])) target)] (wrap head)))) @@ -182,19 +182,19 @@ (ma tx'))))) (def: #export (update! f var) - {#;doc "Will update a Var's value, and return a tuple with the old and the new values."} + {#.doc "Will update a Var's value, and return a tuple with the old and the new values."} (All [a] (-> (-> a a) (Var a) (IO [a a]))) (io (loop [_ []] - (let [(^@ state [value observers]) (io;run (atom;read var)) + (let [(^@ state [value observers]) (io.run (atom.read var)) value' (f value)] - (if (io;run (atom;compare-and-swap state + (if (io.run (atom.compare-and-swap state [value' observers] var)) [value value'] (recur [])))))) (def: #export (update f var) - {#;doc "Will update a Var's value, and return a tuple with the old and the new values."} + {#.doc "Will update a Var's value, and return a tuple with the old and the new values."} (All [a] (-> (-> a a) (Var a) (STM [a a]))) (do Monad<STM> [a (read var) @@ -204,7 +204,7 @@ (def: (can-commit? tx) (-> Tx Bool) - (list;every? (function [[_var _original _current]] + (list.every? (function [[_var _original _current]] (is _original (raw-read _var))) tx)) @@ -212,12 +212,12 @@ (-> (Ex [a] (Tx-Frame a)) Unit) (if (is _original _current) [] - (io;run (write! _current _var)))) + (io.run (write! _current _var)))) (def: fresh-tx Tx (list)) (def: pending-commits - (Var (Ex [a] [(STM a) (P;Promise a)])) + (Var (Ex [a] [(STM a) (P.Promise a)])) (var (:!! []))) (def: commit-processor-flag @@ -225,46 +225,46 @@ (atom false)) (def: (process-commit [stm-proc output]) - (-> [(STM Unit) (P;Promise Unit)] Top) + (-> [(STM Unit) (P.Promise Unit)] Top) (let [[finished-tx value] (stm-proc fresh-tx)] (if (can-commit? finished-tx) (exec (list/map commit-var finished-tx) - (io;run (P;resolve value output))) - (io;run (write! [stm-proc output] pending-commits))))) + (io.run (P.resolve value output))) + (io.run (write! [stm-proc output] pending-commits))))) (def: init-processor! (IO Unit) (do Monad<IO> - [flag (atom;read commit-processor-flag)] + [flag (atom.read commit-processor-flag)] (if flag (wrap []) (do @ - [was-first? (atom;compare-and-swap flag true commit-processor-flag)] + [was-first? (atom.compare-and-swap flag true commit-processor-flag)] (if was-first? (do Monad<IO> [inputs (follow pending-commits)] (exec (|> inputs - (:! (frp;Channel [(STM Unit) (P;Promise Unit)])) - (P;await (function recur [?inputs] + (:! (frp.Channel [(STM Unit) (P.Promise Unit)])) + (P.await (function recur [?inputs] (io (case ?inputs - #;Nil + #.Nil [] - (#;Cons head tail) + (#.Cons head tail) (exec (process-commit head) - (P;await recur tail))))))) + (P.await recur tail))))))) (wrap []))) (wrap []))) ))) (def: #export (commit stm-proc) - {#;doc "Commits a transaction and returns its result (asynchronously). + {#.doc "Commits a transaction and returns its result (asynchronously). Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first. For this reason, it's important to note that transactions must be free from side-effects, such as I/O."} - (All [a] (-> (STM a) (P;Promise a))) - (let [output (P;promise ($ +0))] - (exec (io;run init-processor!) - (io;run (write! [stm-proc output] pending-commits)) + (All [a] (-> (STM a) (P.Promise a))) + (let [output (P.promise ($ +0))] + (exec (io.run init-processor!) + (io.run (write! [stm-proc output] pending-commits)) output))) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index b65d7c563..7f1322bf4 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data ["E" error]) (control ["F" functor] @@ -11,11 +11,11 @@ )) (type: #export (Task a) - (P;Promise (E;Error a))) + (P.Promise (E.Error a))) (def: #export (fail error) (All [a] (-> Text (Task a))) - (:: P;Applicative<Promise> wrap (#E;Error error))) + (:: P.Applicative<Promise> wrap (#E.Error error))) (def: #export (throw exception message) (All [a] (-> Exception Text (Task a))) @@ -23,34 +23,34 @@ (def: #export (return value) (All [a] (-> a (Task a))) - (:: P;Applicative<Promise> wrap (#E;Success value))) + (:: P.Applicative<Promise> wrap (#E.Success value))) (def: #export (try computation) - (All [a] (-> (Task a) (Task (E;Error a)))) - (:: P;Functor<Promise> map (|>> #E;Success) computation)) + (All [a] (-> (Task a) (Task (E.Error a)))) + (:: P.Functor<Promise> map (|>> #E.Success) computation)) -(struct: #export _ (F;Functor Task) +(struct: #export _ (F.Functor Task) (def: (map f fa) - (:: P;Functor<Promise> map + (:: P.Functor<Promise> map (function [fa'] (case fa' - (#E;Error error) - (#E;Error error) + (#E.Error error) + (#E.Error error) - (#E;Success a) - (#E;Success (f a)))) + (#E.Success a) + (#E.Success (f a)))) fa))) -(struct: #export _ (A;Applicative Task) +(struct: #export _ (A.Applicative Task) (def: functor Functor<Task>) (def: wrap return) (def: (apply ff fa) - (do P;Monad<Promise> + (do P.Monad<Promise> [ff' ff fa' fa] - (wrap (do E;Monad<Error> + (wrap (do E.Monad<Error> [f ff' a fa'] (wrap (f a))))))) @@ -59,21 +59,21 @@ (def: applicative Applicative<Task>) (def: (join mma) - (do P;Monad<Promise> + (do P.Monad<Promise> [mma' mma] (case mma' - (#E;Error error) - (wrap (#E;Error error)) + (#E.Error error) + (wrap (#E.Error error)) - (#E;Success ma) + (#E.Success ma) ma)))) -(syntax: #export (task [type s;any]) - {#;doc (doc "Makes an uninitialized Task (in this example, of Unit)." +(syntax: #export (task [type s.any]) + {#.doc (doc "Makes an uninitialized Task (in this example, of Unit)." (task Unit))} - (wrap (list (` (: (;;Task (~ type)) - (P;promise' #;None)))))) + (wrap (list (` (: (..Task (~ type)) + (P.promise' #.None)))))) (def: #export (from-promise promise) - (All [a] (-> (P;Promise a) (Task a))) - (:: P;Functor<Promise> map (|>> #E;Success) promise)) + (All [a] (-> (P.Promise a) (Task a))) + (:: P.Functor<Promise> map (|>> #E.Success) promise)) diff --git a/stdlib/source/lux/control/algebra.lux b/stdlib/source/lux/control/algebra.lux index e743f4497..0f9df072d 100644 --- a/stdlib/source/lux/control/algebra.lux +++ b/stdlib/source/lux/control/algebra.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control functor))) diff --git a/stdlib/source/lux/control/applicative.lux b/stdlib/source/lux/control/applicative.lux index dead34d03..a2326cd84 100644 --- a/stdlib/source/lux/control/applicative.lux +++ b/stdlib/source/lux/control/applicative.lux @@ -1,9 +1,9 @@ -(;module: +(.module: lux (// [functor #+ Functor])) (sig: #export (Applicative f) - {#;doc "Applicative functors."} + {#.doc "Applicative functors."} (: (Functor f) functor) (: (All [a] @@ -14,10 +14,10 @@ apply)) (struct: #export (compose Applicative<F> Applicative<G>) - {#;doc "Applicative functor composition."} + {#.doc "Applicative functor composition."} (All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a)))))) - (def: functor (functor;compose (get@ #functor Applicative<F>) + (def: functor (functor.compose (get@ #functor Applicative<F>) (get@ #functor Applicative<G>))) (def: wrap (|>> (:: Applicative<G> wrap) (:: Applicative<F> wrap))) diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux index 6af4fda10..b1b6df5d9 100644 --- a/stdlib/source/lux/control/codec.lux +++ b/stdlib/source/lux/control/codec.lux @@ -1,19 +1,19 @@ -(;module: +(.module: lux (lux (control monad) (data ["e" error]))) ## [Signatures] (sig: #export (Codec m a) - {#;doc "A way to move back-and-forth between a type and an alternative representation for it."} + {#.doc "A way to move back-and-forth between a type and an alternative representation for it."} (: (-> a m) encode) - (: (-> m (e;Error a)) + (: (-> m (e.Error a)) decode)) ## [Values] (struct: #export (compose Codec<c,b> Codec<b,a>) - {#;doc "Codec composition."} + {#.doc "Codec composition."} (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) @@ -22,7 +22,7 @@ (:: Codec<c,b> encode))) (def: (decode cy) - (do e;Monad<Error> + (do e.Monad<Error> [by (:: Codec<c,b> decode cy)] (:: Codec<b,a> decode by))) ) diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index dd395ff64..69e891219 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -1,14 +1,14 @@ -(;module: +(.module: lux ["F" //functor] (lux/data/coll [list "list/" Fold<List>])) ## [Signatures] (sig: #export (CoMonad w) - {#;doc "CoMonads are the opposite/complement to monads. + {#.doc "CoMonads are the opposite/complement to monads. CoMonadic structures are often infinite in size and built upon lazily-evaluated functions."} - (: (F;Functor w) + (: (F.Functor w) functor) (: (All [a] (-> (w a) a)) @@ -19,42 +19,42 @@ ## [Types] (type: #export (CoFree F a) - {#;doc "The CoFree CoMonad."} + {#.doc "The CoFree CoMonad."} [a (F (CoFree F a))]) ## [Syntax] (def: _cursor Cursor ["" +0 +0]) (macro: #export (be tokens state) - {#;doc (doc "A co-monadic parallel to the \"do\" macro." + {#.doc (doc "A co-monadic parallel to the \"do\" macro." (let [square (function [n] (i/* n n))] (be CoMonad<Stream> [inputs (iterate i/inc 2)] (square (head inputs)))))} (case tokens - (#;Cons comonad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil))) - (if (|> bindings list;size (n/% +2) (n/= +0)) - (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) - g!split (: Code [_cursor (#;Symbol ["" " split "])]) + (#.Cons comonad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil))) + (if (|> bindings list.size (n/% +2) (n/= +0)) + (let [g!map (: Code [_cursor (#.Symbol ["" " map "])]) + g!split (: Code [_cursor (#.Symbol ["" " split "])]) body' (list/fold (: (-> [Code Code] Code Code) (function [binding body'] (let [[var value] binding] (case var - [_ (#;Tag ["" "let"])] + [_ (#.Tag ["" "let"])] (` (let (~ value) (~ body'))) _ (` (|> (~ value) (~ g!split) ((~ g!map) (function [(~ var)] (~ body'))))) )))) body - (list;reverse (list;as-pairs bindings)))] - (#;Right [state (#;Cons (` ("lux case" (~ comonad) + (list.reverse (list.as-pairs bindings)))] + (#.Right [state (#.Cons (` ("lux case" (~ comonad) {(~' @) ("lux case" (~' @) - {{#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} + {{#functor {#F.map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} (~ body')})})) - #;Nil)])) - (#;Left "'be' bindings must have an even number of parts.")) + #.Nil)])) + (#.Left "'be' bindings must have an even number of parts.")) _ - (#;Left "Wrong syntax for 'be'"))) + (#.Left "Wrong syntax for 'be'"))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 9451fa111..104dcf593 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -1,4 +1,4 @@ -(;module: [lux #- if loop when +(.module: [lux #- if loop when n/+ n/- n/* n// n/% n/= n/< n/<= n/> n/>= i/+ i/- i/* i// i/% i/= i/< i/<= i/> i/>= d/+ d/- d/* d// d/% d/= d/< d/<= d/> d/>= @@ -24,21 +24,21 @@ #top (List Code)}) (def: aliases^ - (s;Syntax (List Alias)) - (|> (p;seq s;local-symbol s;any) - p;some - s;record - (p;default (list)))) + (s.Syntax (List Alias)) + (|> (p.seq s.local-symbol s.any) + p.some + s.record + (p.default (list)))) (def: bottom^ - (s;Syntax Nat) - (s;form (p;after (s;this (` #;Bound)) s;nat))) + (s.Syntax Nat) + (s.form (p.after (s.this (` #.Bound)) s.nat))) (def: stack^ - (s;Syntax Stack) - (p;either (p;seq (p;maybe bottom^) - (s;tuple (p;some s;any))) - (p;seq (|> bottom^ (p/map (|>> #;Some))) + (s.Syntax Stack) + (p.either (p.seq (p.maybe bottom^) + (s.tuple (p.some s.any))) + (p.seq (|> bottom^ (p/map (|>> #.Some))) (p/wrap (list))))) (def: (stack-fold tops bottom) @@ -50,38 +50,38 @@ (def: (singleton expander) (-> (Meta (List Code)) (Meta Code)) - (monad;do Monad<Meta> + (monad.do Monad<Meta> [expansion expander] (case expansion - (#;Cons singleton #;Nil) + (#.Cons singleton #.Nil) (wrap singleton) _ - (macro;fail (format "Cannot expand to more than a single AST/Code node:\n" - (|> expansion (L/map %code) (text;join-with " "))))))) + (macro.fail (format "Cannot expand to more than a single AST/Code node:\n" + (|> expansion (L/map %code) (text.join-with " "))))))) (syntax: #export (=> [aliases aliases^] [inputs stack^] [outputs stack^]) (let [de-alias (function [aliased] (L/fold (function [[from to] pre] - (code;replace (code;local-symbol from) to pre)) + (code.replace (code.local-symbol from) to pre)) aliased aliases))] - (case [(|> inputs (get@ #bottom) (m/map (|>> code;nat (~) #;Bound (`)))) - (|> outputs (get@ #bottom) (m/map (|>> code;nat (~) #;Bound (`))))] - [(#;Some bottomI) (#;Some bottomO)] - (monad;do @ - [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) bottomI))) - outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) bottomO)))] + (case [(|> inputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`)))) + (|> outputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`))))] + [(#.Some bottomI) (#.Some bottomO)] + (monad.do @ + [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) bottomI))) + outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) bottomO)))] (wrap (list (` (-> (~ (de-alias inputC)) (~ (de-alias outputC))))))) [?bottomI ?bottomO] (with-gensyms [g!stack] - (monad;do @ - [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) (maybe;default g!stack ?bottomI)))) - outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) (maybe;default g!stack ?bottomO))))] + (monad.do @ + [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) + outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] (wrap (list (` (All [(~ g!stack)] (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) @@ -96,35 +96,35 @@ (def: (prepare command) (-> Code Code) (case command - (^or [_ (#;Bool _)] - [_ (#;Nat _)] [_ (#;Int _)] - [_ (#;Deg _)] [_ (#;Frac _)] - [_ (#;Text _)] - [_ (#;Tag _)] (^ [_ (#;Form (list [_ (#;Tag _)]))])) - (` (;;push (~ command))) + (^or [_ (#.Bool _)] + [_ (#.Nat _)] [_ (#.Int _)] + [_ (#.Deg _)] [_ (#.Frac _)] + [_ (#.Text _)] + [_ (#.Tag _)] (^ [_ (#.Form (list [_ (#.Tag _)]))])) + (` (..push (~ command))) - [_ (#;Tuple block)] - (` (;;push (|>> (~@ (L/map prepare block))))) + [_ (#.Tuple block)] + (` (..push (|>> (~@ (L/map prepare block))))) _ command)) -(syntax: #export (||> [commands (p;some s;any)]) - (wrap (list (` (|> ;;begin! (~@ (L/map prepare commands)) ;;end!))))) +(syntax: #export (||> [commands (p.some s.any)]) + (wrap (list (` (|> ..begin! (~@ (L/map prepare commands)) ..end!))))) -(syntax: #export (word: [export csr;export] [name s;local-symbol] - [annotations (p;default cs;empty-annotations csr;annotations)] +(syntax: #export (word: [export csr.export] [name s.local-symbol] + [annotations (p.default cs.empty-annotations csr.annotations)] type - [commands (p;some s;any)]) - (wrap (list (` (def: (~@ (csw;export export)) (~ (code;local-symbol name)) - (~ (csw;annotations annotations)) + [commands (p.some s.any)]) + (wrap (list (` (def: (~@ (csw.export export)) (~ (code.local-symbol name)) + (~ (csw.annotations annotations)) (~ type) (|>> (~@ (L/map prepare commands)))))))) -(syntax: #export (apply [arity (|> s;nat (p;filter (;n/> +0)))]) +(syntax: #export (apply [arity (|> s.nat (p.filter (.n/> +0)))]) (with-gensyms [g!func g!stack g!output] - (monad;do @ - [g!inputs (|> (macro;gensym "input") (list;repeat arity) (monad;seq @))] + (monad.do @ + [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))] (wrap (list (` (: (All [(~@ g!inputs) (~ g!output)] (-> (-> (~@ g!inputs) (~ g!output)) (=> [(~@ g!inputs)] [(~ g!output)]))) @@ -198,133 +198,133 @@ (function [[[stack subject] param]] [stack (<func> param subject)]))] - [Nat Nat n/+ ;n/+] - [Nat Nat n/- ;n/-] - [Nat Nat n/* ;n/*] - [Nat Nat n// ;n//] - [Nat Nat n/% ;n/%] - [Nat Bool n/= ;n/=] - [Nat Bool n/< ;n/<] - [Nat Bool n/<= ;n/<=] - [Nat Bool n/> ;n/>] - [Nat Bool n/>= ;n/>=] - - [Int Int i/+ ;i/+] - [Int Int i/- ;i/-] - [Int Int i/* ;i/*] - [Int Int i// ;i//] - [Int Int i/% ;i/%] - [Int Bool i/= ;i/=] - [Int Bool i/< ;i/<] - [Int Bool i/<= ;i/<=] - [Int Bool i/> ;i/>] - [Int Bool i/>= ;i/>=] - - [Deg Deg d/+ ;d/+] - [Deg Deg d/- ;d/-] - [Deg Deg d/* ;d/*] - [Deg Deg d// ;d//] - [Deg Deg d/% ;d/%] - [Deg Bool d/= ;d/=] - [Deg Bool d/< ;d/<] - [Deg Bool d/<= ;d/<=] - [Deg Bool d/> ;d/>] - [Deg Bool d/>= ;d/>=] - - [Frac Frac f/+ ;f/+] - [Frac Frac f/- ;f/-] - [Frac Frac f/* ;f/*] - [Frac Frac f// ;f//] - [Frac Frac f/% ;f/%] - [Frac Bool f/= ;f/=] - [Frac Bool f/< ;f/<] - [Frac Bool f/<= ;f/<=] - [Frac Bool f/> ;f/>] - [Frac Bool f/>= ;f/>=] + [Nat Nat n/+ .n/+] + [Nat Nat n/- .n/-] + [Nat Nat n/* .n/*] + [Nat Nat n// .n//] + [Nat Nat n/% .n/%] + [Nat Bool n/= .n/=] + [Nat Bool n/< .n/<] + [Nat Bool n/<= .n/<=] + [Nat Bool n/> .n/>] + [Nat Bool n/>= .n/>=] + + [Int Int i/+ .i/+] + [Int Int i/- .i/-] + [Int Int i/* .i/*] + [Int Int i// .i//] + [Int Int i/% .i/%] + [Int Bool i/= .i/=] + [Int Bool i/< .i/<] + [Int Bool i/<= .i/<=] + [Int Bool i/> .i/>] + [Int Bool i/>= .i/>=] + + [Deg Deg d/+ .d/+] + [Deg Deg d/- .d/-] + [Deg Deg d/* .d/*] + [Deg Deg d// .d//] + [Deg Deg d/% .d/%] + [Deg Bool d/= .d/=] + [Deg Bool d/< .d/<] + [Deg Bool d/<= .d/<=] + [Deg Bool d/> .d/>] + [Deg Bool d/>= .d/>=] + + [Frac Frac f/+ .f/+] + [Frac Frac f/- .f/-] + [Frac Frac f/* .f/*] + [Frac Frac f// .f//] + [Frac Frac f/% .f/%] + [Frac Bool f/= .f/=] + [Frac Bool f/< .f/<] + [Frac Bool f/<= .f/<=] + [Frac Bool f/> .f/>] + [Frac Bool f/>= .f/>=] ) (def: #export if - (All [..a ..b] - (=> {then (=> ..a ..b) - else (=> ..a ..b)} - ..a [Bool then else] ..b)) + (All [__a __b] + (=> {then (=> __a __b) + else (=> __a __b)} + __a [Bool then else] __b)) (function [[[[stack test] then] else]] - (;if test + (.if test (then stack) (else stack)))) (def: #export call - (All [..a ..b] - (=> {quote (=> ..a ..b)} - ..a [quote] ..b)) + (All [__a __b] + (=> {quote (=> __a __b)} + __a [quote] __b)) (function [[stack block]] (block stack))) (def: #export loop - (All [...] - (=> {test (=> ... ... [Bool])} - ... [test] ...)) + (All [___] + (=> {test (=> ___ ___ [Bool])} + ___ [test] ___)) (function loop [[stack pred]] (let [[stack' verdict] (pred stack)] - (;if verdict + (.if verdict (loop [stack' pred]) stack')))) (def: #export dip - (All [... a] - (=> ... [a (=> ... ...)] - ... [a])) + (All [___ a] + (=> ___ [a (=> ___ ___)] + ___ [a])) (function [[[stack a] quote]] [(quote stack) a])) (def: #export dip2 - (All [... a b] - (=> ... [a b (=> ... ...)] - ... [a b])) + (All [___ a b] + (=> ___ [a b (=> ___ ___)] + ___ [a b])) (function [[[[stack a] b] quote]] [[(quote stack) a] b])) (def: #export do - (All [..a ..b] - (=> {pred (=> ..a ..b [Bool]) - body (=> ..b ..a)} - ..b [pred body] - ..a [pred body])) + (All [__a __b] + (=> {pred (=> __a __b [Bool]) + body (=> __b __a)} + __b [pred body] + __a [pred body])) (function [[[stack pred] body]] [[(body stack) pred] body])) (def: #export while - (All [..a ..b] - (=> {pred (=> ..a ..b [Bool]) - body (=> ..b ..a)} - ..a [pred body] - ..b)) + (All [__a __b] + (=> {pred (=> __a __b [Bool]) + body (=> __b __a)} + __a [pred body] + __b)) (function while [[[stack pred] body]] (let [[stack' verdict] (pred stack)] - (;if verdict + (.if verdict (while [[(body stack') pred] body]) stack')))) (def: #export compose - (All [..a ..b ..c] - (=> [(=> ..a ..b) (=> ..b ..c)] - [(=> ..a ..c)])) + (All [__a __b __c] + (=> [(=> __a __b) (=> __b __c)] + [(=> __a __c)])) (function [[[stack f] g]] [stack (|>> f g)])) (def: #export curry - (All [..a ..b a] - (=> ..a [a (=> ..a [a] ..b)] - ..a [(=> ..a ..b)])) + (All [__a __b a] + (=> __a [a (=> __a [a] __b)] + __a [(=> __a __b)])) (function [[[stack arg] quote]] [stack (|>> (push arg) quote)])) ## [Words] (word: #export when - (All [...] - (=> {body (=> ... ...)} - ... [Bool body] - ...)) + (All [___] + (=> {body (=> ___ ___)} + ___ [Bool body] + ___)) swap [call] [drop] if) (word: #export ? diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux index 1d5576ca0..db0202e40 100644 --- a/stdlib/source/lux/control/cont.lux +++ b/stdlib/source/lux/control/cont.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -9,16 +9,16 @@ [syntax #+ syntax:]))) (type: #export (Cont i o) - {#;doc "Continuations."} + {#.doc "Continuations."} (-> (-> i o) o)) (def: #export (continue k cont) - {#;doc "Forces a continuation thunk to be evaluated."} + {#.doc "Forces a continuation thunk to be evaluated."} (All [i o] (-> (-> i o) (Cont i o) o)) (cont k)) (def: #export (run cont) - {#;doc "Forces a continuation thunk to be evaluated."} + {#.doc "Forces a continuation thunk to be evaluated."} (All [a] (-> (Cont a a) a)) (cont id)) @@ -46,7 +46,7 @@ (ffa (continue k))))) (def: #export (call/cc f) - {#;doc "Call with current continuation."} + {#.doc "Call with current continuation."} (All [a b z] (-> (-> (-> a (Cont b z)) (Cont a z)) @@ -56,10 +56,10 @@ k))) (syntax: #export (pending expr) - {#;doc (doc "Turns any expression into a function that is pending a continuation." + {#.doc (doc "Turns any expression into a function that is pending a continuation." (pending (some-computation some-input)))} (with-gensyms [g!k] - (wrap (list (` (;function [(~ g!k)] ((~ g!k) (~ expr)))))))) + (wrap (list (` (.function [(~ g!k)] ((~ g!k) (~ expr)))))))) (def: #export (portal init) (All [i o z] diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux index 3b072caa8..ac0ae5432 100644 --- a/stdlib/source/lux/control/contract.lux +++ b/stdlib/source/lux/control/contract.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control monad) (data text/format) @@ -13,25 +13,25 @@ (error! message))) (syntax: #export (pre test expr) - {#;doc (doc "Pre-conditions." + {#.doc (doc "Pre-conditions." "Given a test and an expression to run, only runs the expression if the test passes." "Otherwise, an error is raised." (pre (i/= 4 (i/+ 2 2)) (foo 123 456 789)))} - (wrap (list (` (exec (assert! (~ (code;text (format "Pre-condition failed: " (%code test)))) + (wrap (list (` (exec (assert! (~ (code.text (format "Pre-condition failed: " (%code test)))) (~ test)) (~ expr)))))) (syntax: #export (post test expr) - {#;doc (doc "Post-conditions." + {#.doc (doc "Post-conditions." "Given a predicate and an expression to run, evaluates the expression and then tests the output with the predicate." "If the predicate returns true, returns the value of the expression." "Otherwise, an error is raised." (post i/even? (i/+ 2 2)))} (do @ - [g!output (macro;gensym "")] + [g!output (macro.gensym "")] (wrap (list (` (let [(~ g!output) (~ expr)] - (exec (assert! (~ (code;text (format "Post-condition failed: " (%code test)))) + (exec (assert! (~ (code.text (format "Post-condition failed: " (%code test)))) ((~ test) (~ g!output))) (~ g!output)))))))) diff --git a/stdlib/source/lux/control/enum.lux b/stdlib/source/lux/control/enum.lux index 5cd20c1a2..594f7e71e 100644 --- a/stdlib/source/lux/control/enum.lux +++ b/stdlib/source/lux/control/enum.lux @@ -1,10 +1,10 @@ -(;module: lux +(.module: lux (lux/control [order])) ## [Signatures] (sig: #export (Enum e) - {#;doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."} - (: (order;Order e) order) + {#.doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."} + (: (order.Order e) order) (: (-> e e) succ) (: (-> e e) pred)) @@ -12,10 +12,10 @@ (def: (range' <= succ from to) (All [a] (-> (-> a a Bool) (-> a a) a a (List a))) (if (<= to from) - (#;Cons from (range' <= succ (succ from) to)) - #;Nil)) + (#.Cons from (range' <= succ (succ from) to)) + #.Nil)) (def: #export (range (^open) from to) - {#;doc "An inclusive [from, to] range of values."} + {#.doc "An inclusive [from, to] range of values."} (All [a] (-> (Enum a) a a (List a))) (range' <= succ from to)) diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux index d0f64e908..f75a78fdd 100644 --- a/stdlib/source/lux/control/eq.lux +++ b/stdlib/source/lux/control/eq.lux @@ -1,7 +1,7 @@ -(;module: lux) +(.module: lux) (sig: #export (Eq a) - {#;doc "Equality for a type's instances."} + {#.doc "Equality for a type's instances."} (: (-> a a Bool) =)) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 010fb562f..d14158590 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Exception-handling functionality built on top of the Error type."} +(.module: {#.doc "Exception-handling functionality built on top of the Error type."} lux (lux (control monad) (data ["e" error] @@ -13,7 +13,7 @@ ## [Types] (type: #export Exception - {#;doc "An exception provides a way to decorate error messages."} + {#.doc "An exception provides a way to decorate error messages."} (-> Text Text)) ## [Values] @@ -23,57 +23,57 @@ (def: #export (match? exception error) (-> Exception Text Bool) - (text;starts-with? (exception "") error)) + (text.starts-with? (exception "") error)) (def: #export (catch exception then try) - {#;doc "If a particular exception is detected on a possibly-erroneous value, handle it. + {#.doc "If a particular exception is detected on a possibly-erroneous value, handle it. If no exception was detected, or a different one from the one being checked, then pass along the original value."} (All [a] - (-> Exception (-> Text a) (e;Error a) - (e;Error a))) + (-> Exception (-> Text a) (e.Error a) + (e.Error a))) (case try - (#e;Success output) - (#e;Success output) + (#e.Success output) + (#e.Success output) - (#e;Error error) + (#e.Error error) (let [reference (exception "")] - (if (text;starts-with? reference error) - (#e;Success (|> error - (text;clip (text;size reference) (text;size error)) - maybe;assume + (if (text.starts-with? reference error) + (#e.Success (|> error + (text.clip (text.size reference) (text.size error)) + maybe.assume then)) - (#e;Error error))))) + (#e.Error error))))) (def: #export (otherwise to-do try) - {#;doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} + {#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} (All [a] - (-> (-> Text a) (e;Error a) a)) + (-> (-> Text a) (e.Error a) a)) (case try - (#e;Success output) + (#e.Success output) output - (#e;Error error) + (#e.Error error) (to-do error))) (def: #export (return value) - {#;doc "A way to lift normal values into the error-handling context."} - (All [a] (-> a (e;Error a))) - (#e;Success value)) + {#.doc "A way to lift normal values into the error-handling context."} + (All [a] (-> a (e.Error a))) + (#e.Success value)) (def: #export (throw exception message) - {#;doc "Decorate an error message with an Exception and lift it into the error-handling context."} - (All [a] (-> Exception Text (e;Error a))) - (#e;Error (exception message))) + {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."} + (All [a] (-> Exception Text (e.Error a))) + (#e.Error (exception message))) -(syntax: #export (exception: [_ex-lev csr;export] [name s;local-symbol]) - {#;doc (doc "Define a new exception type." +(syntax: #export (exception: [_ex-lev csr.export] [name s.local-symbol]) + {#.doc (doc "Define a new exception type." "It moslty just serves as a way to tag error messages for later catching." (exception: #export Some-Exception))} (do @ - [current-module macro;current-module-name - #let [descriptor ($_ text/compose "{" current-module ";" name "}" "\n") - g!message (code;symbol ["" "message"])]] - (wrap (list (` (def: (~@ (csw;export _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message)) + [current-module macro.current-module-name + #let [descriptor ($_ text/compose "{" current-module "." name "}" "\n") + g!message (code.symbol ["" "message"])]] + (wrap (list (` (def: (~@ (csw.export _ex-lev)) ((~ (code.symbol ["" name])) (~ g!message)) Exception - (_text/compose_ (~ (code;text descriptor)) (~ g!message)))))))) + (_text/compose_ (~ (code.text descriptor)) (~ g!message)))))))) diff --git a/stdlib/source/lux/control/fold.lux b/stdlib/source/lux/control/fold.lux index 00bf82fcf..947461c09 100644 --- a/stdlib/source/lux/control/fold.lux +++ b/stdlib/source/lux/control/fold.lux @@ -1,8 +1,8 @@ -(;module: lux) +(.module: lux) ## [Signatures] (sig: #export (Fold F) - {#;doc "Iterate over a structure's values to build a summary value."} + {#.doc "Iterate over a structure's values to build a summary value."} (: (All [a b] (-> (-> b a a) a (F b) a)) fold)) diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux index 756cec583..38b3f0ee3 100644 --- a/stdlib/source/lux/control/functor.lux +++ b/stdlib/source/lux/control/functor.lux @@ -1,4 +1,4 @@ -(;module: lux) +(.module: lux) (sig: #export (Functor f) (: (All [a b] @@ -18,7 +18,7 @@ (All [a] (f (g a)))) (struct: #export (compose Functor<F> Functor<G>) - {#;doc "Functor composition."} + {#.doc "Functor composition."} (All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a)))))) (def: (map f fga) (:: Functor<F> map (:: Functor<G> map f) fga))) diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux index ae72d4cf0..722b0fdca 100644 --- a/stdlib/source/lux/control/hash.lux +++ b/stdlib/source/lux/control/hash.lux @@ -1,10 +1,10 @@ -(;module: +(.module: lux (// [eq #+ Eq])) ## [Signatures] (sig: #export (Hash a) - {#;doc "A way to produce hash-codes for a type's instances. + {#.doc "A way to produce hash-codes for a type's instances. A necessity when working with some data-structures, such as dictionaries or sets."} (: (Eq a) diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux index 16a78e282..90addfe19 100644 --- a/stdlib/source/lux/control/interval.lux +++ b/stdlib/source/lux/control/interval.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] [order] @@ -6,7 +6,7 @@ ## Signatures (sig: #export (Interval a) - {#;doc "A representation of top and bottom boundaries for an ordered type."} + {#.doc "A representation of top and bottom boundaries for an ordered type."} (: (Enum a) enum) @@ -72,14 +72,14 @@ (def: #export (union left right) (All [a] (-> (Interval a) (Interval a) (Interval a))) (struct (def: enum (get@ #enum right)) - (def: bottom (order;min (:: right order) (:: left bottom) (:: right bottom))) - (def: top (order;max (:: right order) (:: left top) (:: right top))))) + (def: bottom (order.min (:: right order) (:: left bottom) (:: right bottom))) + (def: top (order.max (:: right order) (:: left top) (:: right top))))) (def: #export (intersection left right) (All [a] (-> (Interval a) (Interval a) (Interval a))) (struct (def: enum (get@ #enum right)) - (def: bottom (order;max (:: right order) (:: left bottom) (:: right bottom))) - (def: top (order;min (:: right order) (:: left top) (:: right top))))) + (def: bottom (order.max (:: right order) (:: left bottom) (:: right bottom))) + (def: top (order.min (:: right order) (:: left top) (:: right top))))) (def: #export (complement interval) (All [a] (-> (Interval a) (Interval a))) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index e4495cc92..fd940ea83 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (// (functor #as F) (applicative #as A))) @@ -8,10 +8,10 @@ (All [a b] (-> (-> b a a) a (List b) a)) (case xs - #;Nil + #.Nil init - (#;Cons x xs') + (#.Cons x xs') (list/fold f (f x init) xs'))) (def: (list/size xs) @@ -19,31 +19,31 @@ (loop [counter +0 xs xs] (case xs - #;Nil + #.Nil counter - (#;Cons _ xs') + (#.Cons _ xs') (recur (n/inc counter) xs')))) (def: (reverse xs) (All [a] (-> (List a) (List a))) - (list/fold (function [head tail] (#;Cons head tail)) - #;Nil + (list/fold (function [head tail] (#.Cons head tail)) + #.Nil xs)) (def: (as-pairs xs) (All [a] (-> (List a) (List [a a]))) (case xs - (#;Cons x1 (#;Cons x2 xs')) - (#;Cons [x1 x2] (as-pairs xs')) + (#.Cons x1 (#.Cons x2 xs')) + (#.Cons [x1 x2] (as-pairs xs')) _ - #;Nil)) + #.Nil)) ## [Signatures] (sig: #export (Monad m) - (: (A;Applicative m) + (: (A.Applicative m) applicative) (: (All [a] (-> (m (m a)) (m a))) @@ -53,22 +53,22 @@ (def: _cursor Cursor ["" +0 +0]) (macro: #export (do tokens state) - {#;doc (doc "Macro for easy concatenation of monadic operations." + {#.doc (doc "Macro for easy concatenation of monadic operations." (do Monad<Maybe> [y (f1 x) z (f2 z)] (wrap (f3 z))))} (case tokens - (#;Cons monad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil))) + (#.Cons monad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil))) (if (|> bindings list/size (n/% +2) (n/= +0)) - (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) - g!join (: Code [_cursor (#;Symbol ["" " join "])]) - g!apply (: Code [_cursor (#;Symbol ["" " apply "])]) + (let [g!map (: Code [_cursor (#.Symbol ["" " map "])]) + g!join (: Code [_cursor (#.Symbol ["" " join "])]) + g!apply (: Code [_cursor (#.Symbol ["" " apply "])]) body' (list/fold (: (-> [Code Code] Code Code) (function [binding body'] (let [[var value] binding] (case var - [_ (#;Tag ["" "let"])] + [_ (#.Tag ["" "let"])] (` (let (~ value) (~ body'))) _ @@ -76,67 +76,67 @@ )))) body (reverse (as-pairs bindings)))] - (#;Right [state (#;Cons (` ("lux case" (~ monad) + (#.Right [state (#.Cons (` ("lux case" (~ monad) {(~' @) ("lux case" (~' @) - {{#applicative {#A;functor {#F;map (~ g!map)} - #A;wrap (~' wrap) - #A;apply (~ g!apply)} + {{#applicative {#A.functor {#F.map (~ g!map)} + #A.wrap (~' wrap) + #A.apply (~ g!apply)} #join (~ g!join)} (~ body')})})) - #;Nil)])) - (#;Left "'do' bindings must have an even number of parts.")) + #.Nil)])) + (#.Left "'do' bindings must have an even number of parts.")) _ - (#;Left "Wrong syntax for 'do'"))) + (#.Left "Wrong syntax for 'do'"))) ## [Functions] (def: #export (seq monad xs) - {#;doc "Run all the monadic values in the list and produce a list of the base values."} + {#.doc "Run all the monadic values in the list and produce a list of the base values."} (All [M a] (-> (Monad M) (List (M a)) (M (List a)))) (case xs - #;Nil - (:: monad wrap #;Nil) + #.Nil + (:: monad wrap #.Nil) - (#;Cons x xs') + (#.Cons x xs') (do monad [_x x _xs (seq monad xs')] - (wrap (#;Cons _x _xs))) + (wrap (#.Cons _x _xs))) )) (def: #export (map monad f xs) - {#;doc "Apply a monad-producing function to all values in a list."} + {#.doc "Apply a monad-producing function to all values in a list."} (All [M a b] (-> (Monad M) (-> a (M b)) (List a) (M (List b)))) (case xs - #;Nil - (:: monad wrap #;Nil) + #.Nil + (:: monad wrap #.Nil) - (#;Cons x xs') + (#.Cons x xs') (do monad [_x (f x) _xs (map monad f xs')] - (wrap (#;Cons _x _xs))) + (wrap (#.Cons _x _xs))) )) (def: #export (fold monad f init xs) - {#;doc "Fold a list with a monad-producing function."} + {#.doc "Fold a list with a monad-producing function."} (All [M a b] (-> (Monad M) (-> b a (M a)) a (List b) (M a))) (case xs - #;Nil + #.Nil (:: monad wrap init) - (#;Cons x xs') + (#.Cons x xs') (do monad [init' (f x init)] (fold monad f init' xs')))) (def: #export (lift Monad<M> f) - {#;doc "Lift a normal function into the space of monads."} + {#.doc "Lift a normal function into the space of monads."} (All [M a b] (-> (Monad M) (-> a b) (-> (M a) (M b)))) (function [ma] @@ -146,12 +146,12 @@ ## [Free Monads] (type: #export (Free F a) - {#;doc "The Free Monad."} + {#.doc "The Free Monad."} (#Pure a) (#Effect (F (Free F a)))) (struct: #export (Functor<Free> dsl) - (All [F] (-> (F;Functor F) (F;Functor (Free F)))) + (All [F] (-> (F.Functor F) (F.Functor (Free F)))) (def: (map f ea) (case ea (#Pure a) @@ -161,7 +161,7 @@ (#Effect (:: dsl map (map f) value))))) (struct: #export (Applicative<Free> dsl) - (All [F] (-> (F;Functor F) (A;Applicative (Free F)))) + (All [F] (-> (F.Functor F) (A.Applicative (Free F)))) (def: functor (Functor<Free> dsl)) (def: (wrap a) @@ -184,7 +184,7 @@ ))) (struct: #export (Monad<Free> dsl) - (All [F] (-> (F;Functor F) (Monad (Free F)))) + (All [F] (-> (F.Functor F) (Monad (Free F)))) (def: applicative (Applicative<Free> dsl)) (def: (join efefa) diff --git a/stdlib/source/lux/control/monoid.lux b/stdlib/source/lux/control/monoid.lux index 6634445a6..c073bdb0b 100644 --- a/stdlib/source/lux/control/monoid.lux +++ b/stdlib/source/lux/control/monoid.lux @@ -1,7 +1,7 @@ -(;module: lux) +(.module: lux) (sig: #export (Monoid a) - {#;doc "A way to compose values. + {#.doc "A way to compose values. Includes an identity value which does not alter any other value when combined with."} (: a diff --git a/stdlib/source/lux/control/number.lux b/stdlib/source/lux/control/number.lux index 52ed7bf0f..1087f69ea 100644 --- a/stdlib/source/lux/control/number.lux +++ b/stdlib/source/lux/control/number.lux @@ -1,9 +1,9 @@ -(;module: +(.module: lux) ## [Signatures] (sig: #export (Number n) - {#;doc "Everything that should be expected of a number type."} + {#.doc "Everything that should be expected of a number type."} (do-template [<name>] [(: (-> n n n) <name>)] diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux index fe8169443..0e67a9b56 100644 --- a/stdlib/source/lux/control/order.lux +++ b/stdlib/source/lux/control/order.lux @@ -1,11 +1,11 @@ -(;module: +(.module: lux (lux function) (// [eq #+ Eq])) ## [Signatures] (sig: #export (Order a) - {#;doc "A signature for types that possess some sense of ordering among their elements."} + {#.doc "A signature for types that possess some sense of ordering among their elements."} (: (Eq a) eq) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 095104f09..6ac2349ea 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -1,4 +1,4 @@ -(;module: +(.module: [lux #- not] (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -9,40 +9,40 @@ ["e" error]))) (type: #export (Parser s a) - {#;doc "A generic parser."} - (-> s (e;Error [s a]))) + {#.doc "A generic parser."} + (-> s (e.Error [s a]))) ## [Structures] (struct: #export Functor<Parser> (All [s] (Functor (Parser s))) (def: (map f ma) (function [input] (case (ma input) - (#e;Error msg) - (#e;Error msg) + (#e.Error msg) + (#e.Error msg) - (#e;Success [input' a]) - (#e;Success [input' (f a)]))))) + (#e.Success [input' a]) + (#e.Success [input' (f a)]))))) (struct: #export Applicative<Parser> (All [s] (Applicative (Parser s))) (def: functor Functor<Parser>) (def: (wrap x) (function [input] - (#e;Success [input x]))) + (#e.Success [input x]))) (def: (apply ff fa) (function [input] (case (ff input) - (#e;Success [input' f]) + (#e.Success [input' f]) (case (fa input') - (#e;Success [input'' a]) - (#e;Success [input'' (f a)]) + (#e.Success [input'' a]) + (#e.Success [input'' (f a)]) - (#e;Error msg) - (#e;Error msg)) + (#e.Error msg) + (#e.Error msg)) - (#e;Error msg) - (#e;Error msg))))) + (#e.Error msg) + (#e.Error msg))))) (struct: #export Monad<Parser> (All [s] (Monad (Parser s))) (def: applicative Applicative<Parser>) @@ -50,50 +50,50 @@ (def: (join mma) (function [input] (case (mma input) - (#e;Error msg) - (#e;Error msg) + (#e.Error msg) + (#e.Error msg) - (#e;Success [input' ma]) + (#e.Success [input' ma]) (ma input'))))) ## [Parsers] (def: #export (assert message test) - {#;doc "Fails with the given message if the test is false."} + {#.doc "Fails with the given message if the test is false."} (All [s] (-> Text Bool (Parser s Unit))) (function [input] (if test - (#e;Success [input []]) - (#e;Error message)))) + (#e.Success [input []]) + (#e.Error message)))) (def: #export (maybe p) - {#;doc "Optionality combinator."} + {#.doc "Optionality combinator."} (All [s a] (-> (Parser s a) (Parser s (Maybe a)))) (function [input] (case (p input) - (#e;Error _) (#e;Success [input #;None]) - (#e;Success [input' x]) (#e;Success [input' (#;Some x)])))) + (#e.Error _) (#e.Success [input #.None]) + (#e.Success [input' x]) (#e.Success [input' (#.Some x)])))) (def: #export (run input p) (All [s a] - (-> s (Parser s a) (e;Error [s a]))) + (-> s (Parser s a) (e.Error [s a]))) (p input)) (def: #export (some p) - {#;doc "0-or-more combinator."} + {#.doc "0-or-more combinator."} (All [s a] (-> (Parser s a) (Parser s (List a)))) (function [input] (case (p input) - (#e;Error _) (#e;Success [input (list)]) - (#e;Success [input' x]) (run input' + (#e.Error _) (#e.Success [input (list)]) + (#e.Success [input' x]) (run input' (do Monad<Parser> [xs (some p)] (wrap (list& x xs))) )))) (def: #export (many p) - {#;doc "1-or-more combinator."} + {#.doc "1-or-more combinator."} (All [s a] (-> (Parser s a) (Parser s (List a)))) (do Monad<Parser> @@ -102,7 +102,7 @@ (wrap (list& x xs)))) (def: #export (seq p1 p2) - {#;doc "Sequencing combinator."} + {#.doc "Sequencing combinator."} (All [s a b] (-> (Parser s a) (Parser s b) (Parser s [a b]))) (do Monad<Parser> @@ -111,40 +111,40 @@ (wrap [x1 x2]))) (def: #export (alt p1 p2) - {#;doc "Heterogeneous alternative combinator."} + {#.doc "Heterogeneous alternative combinator."} (All [s a b] (-> (Parser s a) (Parser s b) (Parser s (| a b)))) (function [tokens] (case (p1 tokens) - (#e;Success [tokens' x1]) (#e;Success [tokens' (+0 x1)]) - (#e;Error _) (run tokens + (#e.Success [tokens' x1]) (#e.Success [tokens' (+0 x1)]) + (#e.Error _) (run tokens (do Monad<Parser> [x2 p2] (wrap (+1 x2)))) ))) (def: #export (either pl pr) - {#;doc "Homogeneous alternative combinator."} + {#.doc "Homogeneous alternative combinator."} (All [s a] (-> (Parser s a) (Parser s a) (Parser s a))) (function [tokens] (case (pl tokens) - (#e;Error _) (pr tokens) + (#e.Error _) (pr tokens) output output ))) (def: #export (exactly n p) - {#;doc "Parse exactly N times."} + {#.doc "Parse exactly N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (if (n/> +0 n) (do Monad<Parser> [x p xs (exactly (n/dec n) p)] - (wrap (#;Cons x xs))) + (wrap (#.Cons x xs))) (:: Monad<Parser> wrap (list)))) (def: #export (at-least n p) - {#;doc "Parse at least N times."} + {#.doc "Parse at least N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (do Monad<Parser> [min (exactly n p) @@ -152,78 +152,78 @@ (wrap (list/compose min extra)))) (def: #export (at-most n p) - {#;doc "Parse at most N times."} + {#.doc "Parse at most N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (if (n/> +0 n) (function [input] (case (p input) - (#e;Error msg) - (#e;Success [input (list)]) + (#e.Error msg) + (#e.Success [input (list)]) - (#e;Success [input' x]) + (#e.Success [input' x]) (run input' (do Monad<Parser> [xs (at-most (n/dec n) p)] - (wrap (#;Cons x xs)))) + (wrap (#.Cons x xs)))) )) (:: Monad<Parser> wrap (list)))) (def: #export (between from to p) - {#;doc "Parse between N and M times."} + {#.doc "Parse between N and M times."} (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a)))) (do Monad<Parser> [min-xs (exactly from p) max-xs (at-most (n/- from to) p)] - (wrap (:: list;Monad<List> join (list min-xs max-xs))))) + (wrap (:: list.Monad<List> join (list min-xs max-xs))))) (def: #export (sep-by sep p) - {#;doc "Parsers instances of 'p' that are separated by instances of 'sep'."} + {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) (do Monad<Parser> [?x (maybe p)] (case ?x - #;None - (wrap #;Nil) + #.None + (wrap #.Nil) - (#;Some x) + (#.Some x) (do @ [xs' (some (seq sep p))] - (wrap (#;Cons x (list/map product;right xs')))) + (wrap (#.Cons x (list/map product.right xs')))) ))) (def: #export (not p) (All [s a] (-> (Parser s a) (Parser s Unit))) (function [input] (case (p input) - (#e;Error msg) - (#e;Success [input []]) + (#e.Error msg) + (#e.Success [input []]) _ - (#e;Error "Expected to fail; yet succeeded.")))) + (#e.Error "Expected to fail; yet succeeded.")))) (def: #export (fail message) (All [s a] (-> Text (Parser s a))) (function [input] - (#e;Error message))) + (#e.Error message))) (def: #export (default value parser) - {#;doc "If the given parser fails, returns the default value."} + {#.doc "If the given parser fails, returns the default value."} (All [s a] (-> a (Parser s a) (Parser s a))) (function [input] (case (parser input) - (#e;Error error) - (#e;Success [input value]) + (#e.Error error) + (#e.Success [input value]) - (#e;Success [input' output]) - (#e;Success [input' output])))) + (#e.Success [input' output]) + (#e.Success [input' output])))) (def: #export remaining (All [s] (Parser s s)) (function [inputs] - (#e;Success [inputs inputs]))) + (#e.Success [inputs inputs]))) (def: #export (rec parser) - {#;doc "Combinator for recursive parser."} + {#.doc "Combinator for recursive parser."} (All [s a] (-> (-> (Parser s a) (Parser s a)) (Parser s a))) (function [inputs] (run inputs (parser (rec parser))))) @@ -249,16 +249,16 @@ (wrap output))) (def: #export (codec Codec<a,z> parser) - (All [s a z] (-> (codec;Codec a z) (Parser s a) (Parser s z))) + (All [s a z] (-> (codec.Codec a z) (Parser s a) (Parser s z))) (function [input] (case (parser input) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success [input' to-decode]) + (#e.Success [input' to-decode]) (case (:: Codec<a,z> decode to-decode) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success value) - (#e;Success [input' value]))))) + (#e.Success value) + (#e.Success [input' value]))))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 9903986f7..f8208fee6 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."} +(.module: {#.doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."} lux (lux (control ["M" monad #+ do Monad] ["p" parser]) @@ -11,32 +11,32 @@ ## [Syntax] (def: body^ (Syntax (List Code)) - (s;tuple (p;many s;any))) + (s.tuple (p.many s.any))) -(syntax: #export (new> [tokens (p;at-least +2 s;any)]) - {#;doc (doc "Ignores the piped argument, and begins a new pipe." +(syntax: #export (new> [tokens (p.at-least +2 s.any)]) + {#.doc (doc "Ignores the piped argument, and begins a new pipe." (|> 20 (i/* 3) (i/+ 4) (new> 0 i/inc)))} - (case (list;reverse tokens) + (case (list.reverse tokens) (^ (list& _ r-body)) - (wrap (list (` (|> (~@ (list;reverse r-body)))))) + (wrap (list (` (|> (~@ (list.reverse r-body)))))) _ (undefined))) (syntax: #export (let> binding body prev) - {#;doc (doc "Gives a name to the piped-argument, within the given expression." + {#.doc (doc "Gives a name to the piped-argument, within the given expression." (|> 5 (let> X (i/+ X X))))} (wrap (list (` (let [(~ binding) (~ prev)] (~ body)))))) -(syntax: #export (cond> [branches (p;many (p;seq body^ body^))] - [?else (p;maybe body^)] +(syntax: #export (cond> [branches (p.many (p.seq body^ body^))] + [?else (p.maybe body^)] prev) - {#;doc (doc "Branching for pipes." + {#.doc (doc "Branching for pipes." "Both the tests and the bodies are piped-code, and must be given inside a tuple." "If a last else-pipe is not given, the piped-argument will be used instead." (|> 5 @@ -51,14 +51,14 @@ (list (` (|> (~ g!temp) (~@ test))) (` (|> (~ g!temp) (~@ then)))))) (~ (case ?else - (#;Some else) + (#.Some else) (` (|> (~ g!temp) (~@ else))) _ g!temp))))))))) (syntax: #export (loop> [test body^] [then body^] prev) - {#;doc (doc "Loops for pipes." + {#.doc (doc "Loops for pipes." "Both the testing and calculating steps are pipes and must be given inside tuples." (|> 1 (loop> [(i/< 10)] @@ -69,8 +69,8 @@ ((~' recur) (|> (~ g!temp) (~@ then))) (~ g!temp)))))))) -(syntax: #export (do> monad [steps (p;some body^)] prev) - {#;doc (doc "Monadic pipes." +(syntax: #export (do> monad [steps (p.some body^)] prev) + {#.doc (doc "Monadic pipes." "Each steps in the monadic computation is a pipe and must be given inside a tuple." (|> 5 (do> Monad<Identity> @@ -78,10 +78,10 @@ [(i/+ 4)] [i/inc])))} (with-gensyms [g!temp] - (case (list;reverse steps) + (case (list.reverse steps) (^ (list& last-step prev-steps)) (let [step-bindings (do Monad<List> - [step (list;reverse prev-steps)] + [step (list.reverse prev-steps)] (list g!temp (` (|> (~ g!temp) (~@ step)))))] (wrap (list (` (do (~ monad) [(~ g!temp) (~ prev) @@ -92,19 +92,19 @@ (wrap (list prev))))) (syntax: #export (exec> [body body^] prev) - {#;doc (doc "Non-updating pipes." + {#.doc (doc "Non-updating pipes." "Will generate piped computations, but their results will not be used in the larger scope." (|> 5 (exec> [int-to-nat %n log!]) (i/* 10)))} (do @ - [g!temp (macro;gensym "")] + [g!temp (macro.gensym "")] (wrap (list (` (let [(~ g!temp) (~ prev)] (exec (|> (~ g!temp) (~@ body)) (~ g!temp)))))))) -(syntax: #export (tuple> [paths (p;many body^)] prev) - {#;doc (doc "Parallel branching for pipes." +(syntax: #export (tuple> [paths (p.many body^)] prev) + {#.doc (doc "Parallel branching for pipes." "Allows to run multiple pipelines for a value and gives you a tuple of the outputs." (|> 5 (tuple> [(i/* 10)] @@ -112,13 +112,13 @@ [Int/encode])) "Will become: [50 2 \"5\"]")} (do @ - [g!temp (macro;gensym "")] + [g!temp (macro.gensym "")] (wrap (list (` (let [(~ g!temp) (~ prev)] [(~@ (L/map (function [body] (` (|> (~ g!temp) (~@ body)))) paths))])))))) -(syntax: #export (case> [branches (p;many (p;seq s;any s;any))] prev) - {#;doc (doc "Pattern-matching for pipes." +(syntax: #export (case> [branches (p.many (p.seq s.any s.any))] prev) + {#.doc (doc "Pattern-matching for pipes." "The bodies of each branch are NOT pipes; just regular values." (|> 5 (case> 0 "zero" diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux index 41ac32f08..74c96c5b2 100644 --- a/stdlib/source/lux/control/reader.lux +++ b/stdlib/source/lux/control/reader.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] ["A" applicative] @@ -6,16 +6,16 @@ ## [Types] (type: #export (Reader r a) - {#;doc "Computations that have access to some environmental value."} + {#.doc "Computations that have access to some environmental value."} (-> r a)) ## [Structures] -(struct: #export Functor<Reader> (All [r] (F;Functor (Reader r))) +(struct: #export Functor<Reader> (All [r] (F.Functor (Reader r))) (def: (map f fa) (function [env] (f (fa env))))) -(struct: #export Applicative<Reader> (All [r] (A;Applicative (Reader r))) +(struct: #export Applicative<Reader> (All [r] (A.Applicative (Reader r))) (def: functor Functor<Reader>) (def: (wrap x) @@ -34,12 +34,12 @@ ## [Values] (def: #export ask - {#;doc "Get the environment."} + {#.doc "Get the environment."} (All [r] (Reader r r)) (function [env] env)) (def: #export (local change proc) - {#;doc "Run computation with a locally-modified environment."} + {#.doc "Run computation with a locally-modified environment."} (All [r a] (-> (-> r r) (Reader r a) (Reader r a))) (|>> change proc)) @@ -48,9 +48,9 @@ (proc env)) (struct: #export (ReaderT Monad<M>) - {#;doc "Monad transformer for Reader."} + {#.doc "Monad transformer for Reader."} (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) - (def: applicative (A;compose Applicative<Reader> (get@ #monad;applicative Monad<M>))) + (def: applicative (A.compose Applicative<Reader> (get@ #monad.applicative Monad<M>))) (def: (join eMeMa) (function [env] (do Monad<M> @@ -58,6 +58,6 @@ (run env eMa))))) (def: #export lift - {#;doc "Lift monadic values to the Reader wrapper."} + {#.doc "Lift monadic values to the Reader wrapper."} (All [M e a] (-> (M a) (Reader e (M a)))) (:: Monad<Reader> wrap)) diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index e791542d5..2a6ab5fb6 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] ["A" applicative] @@ -6,17 +6,17 @@ ## [Types] (type: #export (State s a) - {#;doc "Stateful computations."} + {#.doc "Stateful computations."} (-> s [s a])) ## [Structures] -(struct: #export Functor<State> (All [s] (F;Functor (State s))) +(struct: #export Functor<State> (All [s] (F.Functor (State s))) (def: (map f ma) (function [state] (let [[state' a] (ma state)] [state' (f a)])))) -(struct: #export Applicative<State> (All [s] (A;Applicative (State s))) +(struct: #export Applicative<State> (All [s] (A.Applicative (State s))) (def: functor Functor<State>) (def: (wrap a) @@ -39,50 +39,50 @@ ## [Values] (def: #export get - {#;doc "Read the current state."} + {#.doc "Read the current state."} (All [s] (State s s)) (function [state] [state state])) (def: #export (put new-state) - {#;doc "Set the new state."} + {#.doc "Set the new state."} (All [s] (-> s (State s Unit))) (function [state] [new-state []])) (def: #export (update change) - {#;doc "Compute the new state."} + {#.doc "Compute the new state."} (All [s] (-> (-> s s) (State s Unit))) (function [state] [(change state) []])) (def: #export (use user) - {#;doc "Run function on current state."} + {#.doc "Run function on current state."} (All [s a] (-> (-> s a) (State s a))) (function [state] [state (user state)])) (def: #export (local change action) - {#;doc "Run computation with a locally-modified state."} + {#.doc "Run computation with a locally-modified state."} (All [s a] (-> (-> s s) (State s a) (State s a))) (function [state] (let [[state' output] (action (change state))] [state output]))) (def: #export (run state action) - {#;doc "Run a stateful computation."} + {#.doc "Run a stateful computation."} (All [s a] (-> s (State s a) [s a])) (action state)) (struct: (Functor<StateT> Functor<M>) - (All [M s] (-> (F;Functor M) (F;Functor (All [a] (-> s (M [s a])))))) + (All [M s] (-> (F.Functor M) (F.Functor (All [a] (-> s (M [s a])))))) (def: (map f sfa) (function [state] (:: Functor<M> map (function [[s a]] [s (f a)]) (sfa state))))) (struct: (Applicative<StateT> Monad<M>) - (All [M s] (-> (Monad M) (A;Applicative (All [a] (-> s (M [s a])))))) + (All [M s] (-> (Monad M) (A.Applicative (All [a] (-> s (M [s a])))))) (def: functor (Functor<StateT> (:: Monad<M> functor))) (def: (wrap a) @@ -97,16 +97,16 @@ (wrap [state (f a)]))))) (type: #export (State' M s a) - {#;doc "Stateful computations decorated by a monad."} + {#.doc "Stateful computations decorated by a monad."} (-> s (M [s a]))) (def: #export (run' state action) - {#;doc "Run a stateful computation decorated by a monad."} + {#.doc "Run a stateful computation decorated by a monad."} (All [M s a] (-> s (State' M s a) (M [s a]))) (action state)) (struct: #export (StateT Monad<M>) - {#;doc "A monad transformer to create composite stateful computations."} + {#.doc "A monad transformer to create composite stateful computations."} (All [M s] (-> (Monad M) (Monad (State' M s)))) (def: applicative (Applicative<StateT> Monad<M>)) (def: (join sMsMa) @@ -116,7 +116,7 @@ (sMa state'))))) (def: #export (lift Monad<M> ma) - {#;doc "Lift monadic values to the State' wrapper."} + {#.doc "Lift monadic values to the State' wrapper."} (All [M s a] (-> (Monad M) (M a) (State' M s a))) (function [state] (do Monad<M> diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux index d8785af46..29cec52e1 100644 --- a/stdlib/source/lux/control/writer.lux +++ b/stdlib/source/lux/control/writer.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux/control monoid ["F" functor] @@ -6,18 +6,18 @@ [monad #+ do Monad])) (type: #export (Writer l a) - {#;doc "Represents a value with an associated 'log' value to record arbitrary information."} + {#.doc "Represents a value with an associated 'log' value to record arbitrary information."} {#log l #value a}) (struct: #export Functor<Writer> (All [l] - (F;Functor (Writer l))) + (F.Functor (Writer l))) (def: (map f fa) (let [[log datum] fa] [log (f datum)]))) (struct: #export (Applicative<Writer> mon) (All [l] - (-> (Monoid l) (A;Applicative (Writer l)))) + (-> (Monoid l) (A.Applicative (Writer l)))) (def: functor Functor<Writer>) (def: (wrap x) @@ -37,13 +37,13 @@ [(:: mon compose log1 log2) a]))) (def: #export (log l) - {#;doc "Set the log to a particular value."} + {#.doc "Set the log to a particular value."} (All [l] (-> l (Writer l Unit))) [l []]) (struct: #export (WriterT Monoid<l> Monad<M>) (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a)))))) - (def: applicative (A;compose (get@ #monad;applicative Monad<M>) (Applicative<Writer> Monoid<l>))) + (def: applicative (A.compose (get@ #monad.applicative Monad<M>) (Applicative<Writer> Monoid<l>))) (def: (join MlMla) (do Monad<M> [[l1 Mla] (: (($ +1) (Writer ($ +0) (($ +1) (Writer ($ +0) ($ +2))))) diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index b0b31d2dd..4f9474a90 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -1,11 +1,11 @@ -(;module: [lux #- and or not]) +(.module: [lux #- and or not]) (def: #export width Nat +64) ## [Values] (do-template [<short-name> <op> <doc> <type>] [(def: #export (<short-name> param subject) - {#;doc <doc>} + {#.doc <doc>} (-> Nat <type> <type>) (<op> subject param))] @@ -18,40 +18,40 @@ ) (def: #export (count subject) - {#;doc "Count the number of 1s in a bit-map."} + {#.doc "Count the number of 1s in a bit-map."} (-> Nat Nat) ("lux bit count" subject)) (def: #export not - {#;doc "Bitwise negation."} + {#.doc "Bitwise negation."} (-> Nat Nat) (let [mask (int-to-nat -1)] (xor mask))) (def: #export (clear idx input) - {#;doc "Clear bit at given index."} + {#.doc "Clear bit at given index."} (-> Nat Nat Nat) - (;;and (;;not (shift-left idx +1)) + (..and (..not (shift-left idx +1)) input)) (do-template [<name> <op> <doc>] [(def: #export (<name> idx input) - {#;doc <doc>} + {#.doc <doc>} (-> Nat Nat Nat) (<op> (shift-left idx +1) input))] - [set ;;or "Set bit at given index."] - [flip ;;xor "Flip bit at given index."] + [set ..or "Set bit at given index."] + [flip ..xor "Flip bit at given index."] ) (def: #export (set? idx input) (-> Nat Nat Bool) - (|> input (;;and (shift-left idx +1)) (n/= +0) ;not)) + (|> input (..and (shift-left idx +1)) (n/= +0) .not)) (do-template [<name> <main> <comp>] [(def: #export (<name> distance input) (-> Nat Nat Nat) - (;;or (<main> distance input) + (..or (<main> distance input) (<comp> (n/- (n/% width distance) width) input)))] diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux index e737c6118..9ccbc87ab 100644 --- a/stdlib/source/lux/data/bool.lux +++ b/stdlib/source/lux/data/bool.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [eq #+ Eq] @@ -38,13 +38,13 @@ (def: (decode input) (case input - "true" (#;Right true) - "false" (#;Right false) - _ (#;Left "Wrong syntax for Bool.")))) + "true" (#.Right true) + "false" (#.Right false) + _ (#.Left "Wrong syntax for Bool.")))) ## [Values] (def: #export complement - {#;doc "Generates the complement of a predicate. + {#.doc "Generates the complement of a predicate. That is a predicate that returns the oposite of the original predicate."} (All [a] (-> (-> a Bool) (-> a Bool))) (compose not)) diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index ac15bfe9d..b45cab136 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [functor #+ Functor] @@ -38,29 +38,29 @@ dest-array (list/fold (function [offset target] (case (read (n/+ offset src-start) src-array) - #;None + #.None target - (#;Some value) + (#.Some value) (write (n/+ offset dest-start) value target))) dest-array - (list;n/range +0 (n/dec length))))) + (list.n/range +0 (n/dec length))))) (def: #export (occupied array) - {#;doc "Finds out how many cells in an array are occupied."} + {#.doc "Finds out how many cells in an array are occupied."} (All [a] (-> (Array a) Nat)) (list/fold (function [idx count] (case (read idx array) - #;None + #.None count - (#;Some _) + (#.Some _) (n/inc count))) +0 - (list;indices (size array)))) + (list.indices (size array)))) (def: #export (vacant array) - {#;doc "Finds out how many cells in an array are vacant."} + {#.doc "Finds out how many cells in an array are vacant."} (All [a] (-> (Array a) Nat)) (n/- (occupied array) (size array))) @@ -70,26 +70,26 @@ (list/fold (: (-> Nat (Array ($ +0)) (Array ($ +0))) (function [idx xs'] (case (read idx xs) - #;None + #.None xs' - (#;Some x) + (#.Some x) (if (p x) xs' (delete idx xs'))))) xs - (list;indices (size xs))) + (list.indices (size xs))) ## (list/fold (function [idx xs'] ## (case (read idx xs) - ## #;None + ## #.None ## xs' - ## (#;Some x) + ## (#.Some x) ## (if (p x) ## xs' ## (delete idx xs')))) ## xs - ## (list;indices (size xs))) + ## (list.indices (size xs))) ) (def: #export (find p xs) @@ -99,50 +99,50 @@ (loop [idx +0] (if (n/< arr-size idx) (case (read idx xs) - #;None + #.None (recur (n/inc idx)) - (#;Some x) + (#.Some x) (if (p x) - (#;Some x) + (#.Some x) (recur (n/inc idx)))) - #;None)))) + #.None)))) (def: #export (find+ p xs) - {#;doc "Just like 'find', but with access to the index of each value."} + {#.doc "Just like 'find', but with access to the index of each value."} (All [a] (-> (-> Nat a Bool) (Array a) (Maybe [Nat a]))) (let [arr-size (size xs)] (loop [idx +0] (if (n/< arr-size idx) (case (read idx xs) - #;None + #.None (recur (n/inc idx)) - (#;Some x) + (#.Some x) (if (p idx x) - (#;Some [idx x]) + (#.Some [idx x]) (recur (n/inc idx)))) - #;None)))) + #.None)))) (def: #export (clone xs) (All [a] (-> (Array a) (Array a))) (let [arr-size (size xs)] (list/fold (function [idx ys] (case (read idx xs) - #;None + #.None ys - (#;Some x) + (#.Some x) (write idx x ys))) (new arr-size) - (list;indices arr-size)))) + (list.indices arr-size)))) (def: #export (from-list xs) (All [a] (-> (List a) (Array a))) - (product;right (list/fold (function [x [idx arr]] + (product.right (list/fold (function [x [idx arr]] [(n/inc idx) (write idx x arr)]) - [+0 (new (list;size xs))] + [+0 (new (list.size xs))] xs))) (def: underflow Nat (n/dec +0)) @@ -150,15 +150,15 @@ (def: #export (to-list array) (All [a] (-> (Array a) (List a))) (loop [idx (n/dec (size array)) - output #;Nil] + output #.Nil] (if (n/= underflow idx) output (recur (n/dec idx) (case (read idx array) - (#;Some head) - (#;Cons head output) + (#.Some head) + (#.Cons head output) - #;None + #.None output))))) (struct: #export (Eq<Array> Eq<a>) @@ -170,16 +170,16 @@ (list/fold (function [idx prev] (and prev (case [(read idx xs) (read idx ys)] - [#;None #;None] + [#.None #.None] true - [(#;Some x) (#;Some y)] + [(#.Some x) (#.Some y)] (:: Eq<a> = x y) _ false))) true - (list;n/range +0 (n/dec sxs))))) + (list.n/range +0 (n/dec sxs))))) )) (struct: #export Monoid<Array> (All [a] @@ -201,22 +201,22 @@ (list/fold (: (-> Nat (Array ($ +1)) (Array ($ +1))) (function [idx mb] (case (read idx ma) - #;None + #.None mb - (#;Some x) + (#.Some x) (write idx (f x) mb)))) (new arr-size) - (list;n/range +0 (n/dec arr-size))) + (list.n/range +0 (n/dec arr-size))) ## (list/fold (function [idx mb] ## (case (read idx ma) - ## #;None + ## #.None ## mb - ## (#;Some x) + ## (#.Some x) ## (write idx (f x) mb))) ## (new arr-size) - ## (list;n/range +0 (n/dec arr-size))) + ## (list.n/range +0 (n/dec arr-size))) )))) (struct: #export _ (Fold Array) @@ -226,9 +226,9 @@ idx +0] (if (n/< arr-size idx) (case (read idx xs) - #;None + #.None (recur so-far (n/inc idx)) - (#;Some value) + (#.Some value) (recur (f value so-far) (n/inc idx))) so-far))))) diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index 5ab078e28..5b61830d5 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control hash [eq #+ Eq]) @@ -97,58 +97,58 @@ ## which is 1/4 of the branching factor (or a left-shift 2). (def: demotion-threshold Nat - (bit;shift-left (n/- +2 branching-exponent) +1)) + (bit.shift-left (n/- +2 branching-exponent) +1)) ## The threshold on which #Base nodes are promoted to #Hierarchy nodes, ## which is 1/2 of the branching factor (or a left-shift 1). (def: promotion-threshold Nat - (bit;shift-left (n/- +1 branching-exponent) +1)) + (bit.shift-left (n/- +1 branching-exponent) +1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). (def: hierarchy-nodes-size Nat - (bit;shift-left branching-exponent +1)) + (bit.shift-left branching-exponent +1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty Node - (#Base clean-bitmap (array;new +0))) + (#Base clean-bitmap (array.new +0))) ## Expands a copy of the array, to have 1 extra slot, which is used ## for storing the value. (def: (insert! idx value old-array) (All [a] (-> Index a (Array a) (Array a))) - (let [old-size (array;size old-array)] - (|> ## (array;new (n/inc old-size)) + (let [old-size (array.size old-array)] + (|> ## (array.new (n/inc old-size)) (: (Array ($ +0)) - (array;new (n/inc old-size))) - (array;copy idx +0 old-array +0) - (array;write idx value) - (array;copy (n/- idx old-size) idx old-array (n/inc idx))))) + (array.new (n/inc old-size))) + (array.copy idx +0 old-array +0) + (array.write idx value) + (array.copy (n/- idx old-size) idx old-array (n/inc idx))))) ## Creates a copy of an array with an index set to a particular value. (def: (update! idx value array) (All [a] (-> Index a (Array a) (Array a))) - (|> array array;clone (array;write idx value))) + (|> array array.clone (array.write idx value))) ## Creates a clone of the array, with an empty position at index. (def: (vacant! idx array) (All [a] (-> Index (Array a) (Array a))) - (|> array array;clone (array;delete idx))) + (|> array array.clone (array.delete idx))) ## Shrinks a copy of the array by removing the space at index. (def: (remove! idx array) (All [a] (-> Index (Array a) (Array a))) - (let [new-size (n/dec (array;size array))] - (|> (array;new new-size) - (array;copy idx +0 array +0) - (array;copy (n/- idx new-size) (n/inc idx) array idx)))) + (let [new-size (n/dec (array.size array))] + (|> (array.new new-size) + (array.copy idx +0 array +0) + (array.copy (n/- idx new-size) (n/inc idx) array idx)))) ## Given a top-limit for indices, produces all indices in [0, R). (def: indices-for (-> Nat (List Index)) - (|>> n/dec (list;n/range +0))) + (|>> n/dec (list.n/range +0))) ## Increases the level-shift by the branching-exponent, to explore ## levels further down the tree. @@ -162,13 +162,13 @@ ## to a particular level, and uses that as an index into the array. (def: (level-index level hash) (-> Level Hash-Code Index) - (bit;and hierarchy-mask - (bit;shift-right level hash))) + (bit.and hierarchy-mask + (bit.shift-right level hash))) ## A mechanism to go from indices to bit-positions. (def: (->bit-position index) (-> Index BitPosition) - (bit;shift-left index +1)) + (bit.shift-left index +1)) ## The bit-position within a base that a given hash-code would have. (def: (bit-position level hash) @@ -177,7 +177,7 @@ (def: (bit-position-is-set? bit bitmap) (-> BitPosition BitMap Bool) - (not (n/= clean-bitmap (bit;and bit bitmap)))) + (not (n/= clean-bitmap (bit.and bit bitmap)))) ## Figures out whether a bitmap only contains a single bit-position. (def: only-bit-position? @@ -186,17 +186,17 @@ (def: (set-bit-position bit bitmap) (-> BitPosition BitMap BitMap) - (bit;or bit bitmap)) + (bit.or bit bitmap)) (def: unset-bit-position (-> BitPosition BitMap BitMap) - bit;xor) + bit.xor) ## Figures out the size of a bitmap-indexed array by counting all the ## 1s within the bitmap. (def: bitmap-size (-> BitMap Nat) - bit;count) + bit.count) ## A mask that, for a given bit position, only allows all the 1s prior ## to it, which would indicate the bitmap-size (and, thus, index) @@ -208,14 +208,14 @@ ## The index on the base array, based on it's bit-position. (def: (base-index bit-position bitmap) (-> BitPosition BitMap Index) - (bitmap-size (bit;and (bit-position-mask bit-position) + (bitmap-size (bit.and (bit-position-mask bit-position) bitmap))) ## Produces the index of a KV-pair within a #Collisions node. (def: (collision-index Hash<k> key colls) (All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index))) - (:: Monad<Maybe> map product;left - (array;find+ (function [idx [key' val']] + (:: Monad<Maybe> map product.left + (array.find+ (function [idx [key' val']] (:: Hash<k> = key key')) colls))) @@ -223,22 +223,22 @@ ## nodes to save space. (def: (demote-hierarchy except-idx [h-size h-array]) (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)])) - (product;right (list/fold (function [idx [insertion-idx node]] + (product.right (list/fold (function [idx [insertion-idx node]] (let [[bitmap base] node] - (case (array;read idx h-array) - #;None [insertion-idx node] - (#;Some sub-node) (if (n/= except-idx idx) + (case (array.read idx h-array) + #.None [insertion-idx node] + (#.Some sub-node) (if (n/= except-idx idx) [insertion-idx node] [(n/inc insertion-idx) [(set-bit-position (->bit-position idx) bitmap) - (array;write insertion-idx (#;Left sub-node) base)]]) + (array.write insertion-idx (#.Left sub-node) base)]]) ))) [+0 [clean-bitmap - ## (array;new (n/dec h-size)) + ## (array.new (n/dec h-size)) (: (Base ($ +0) ($ +1)) - (array;new (n/dec h-size))) + (array.new (n/dec h-size))) ]] - (list;indices (array;size h-array))))) + (list.indices (array.size h-array))))) ## When #Base nodes grow too large, they're promoted to #Hierarchy to ## add some depth to the tree and help keep it's balance. @@ -250,26 +250,26 @@ (Hash k) Level BitMap (Base k v) (Array (Node k v)))) - (product;right (list/fold (function [hierarchy-idx (^@ default [base-idx h-array])] + (product.right (list/fold (function [hierarchy-idx (^@ default [base-idx h-array])] (if (bit-position-is-set? (->bit-position hierarchy-idx) bitmap) [(n/inc base-idx) - (case (array;read base-idx base) - (#;Some (#;Left sub-node)) - (array;write hierarchy-idx sub-node h-array) + (case (array.read base-idx base) + (#.Some (#.Left sub-node)) + (array.write hierarchy-idx sub-node h-array) - (#;Some (#;Right [key' val'])) - (array;write hierarchy-idx + (#.Some (#.Right [key' val'])) + (array.write hierarchy-idx (put' (level-up level) (:: Hash<k> hash key') key' val' Hash<k> empty) h-array) - #;None + #.None (undefined))] default)) [+0 - ## (array;new hierarchy-nodes-size) + ## (array.new hierarchy-nodes-size) (: (Array (Node ($ +0) ($ +1))) - (array;new hierarchy-nodes-size)) + (array.new hierarchy-nodes-size)) ] hierarchy-indices))) @@ -279,7 +279,7 @@ (def: (empty?' node) (All [k v] (-> (Node k v) Bool)) (case node - (^~ (#Base ;;clean-bitmap _)) + (^~ (#Base ..clean-bitmap _)) true _ @@ -292,15 +292,15 @@ ## a sub-node. If impossible, I introduced a new singleton sub-node. (#Hierarchy _size hierarchy) (let [idx (level-index level hash) - ## [_size' sub-node] (case (array;read idx hierarchy) - ## (#;Some sub-node) + ## [_size' sub-node] (case (array.read idx hierarchy) + ## (#.Some sub-node) ## [_size sub-node] ## _ ## [(n/inc _size) empty]) [_size' sub-node] (: [Nat (Node ($ +0) ($ +1))] - (case (array;read idx hierarchy) - (#;Some sub-node) + (case (array.read idx hierarchy) + (#.Some sub-node) [_size sub-node] _ @@ -317,33 +317,33 @@ (if (bit-position-is-set? bit bitmap) ## If so... (let [idx (base-index bit bitmap)] - (case (array;read idx base) - #;None + (case (array.read idx base) + #.None (undefined) ## If it's being used by a node, I add the KV to it. - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (let [sub-node' (put' (level-up level) hash key val Hash<k> sub-node)] - (#Base bitmap (update! idx (#;Left sub-node') base))) + (#Base bitmap (update! idx (#.Left sub-node') base))) ## Otherwise, if it's being used by a KV, I compare the keys. - (#;Some (#;Right key' val')) + (#.Some (#.Right key' val')) (if (:: Hash<k> = key key') ## If the same key is found, I replace the value. - (#Base bitmap (update! idx (#;Right key val) base)) + (#Base bitmap (update! idx (#.Right key val) base)) ## Otherwise, I compare the hashes of the keys. (#Base bitmap (update! idx - (#;Left (let [hash' (:: Hash<k> hash key')] + (#.Left (let [hash' (:: Hash<k> hash key')] (if (n/= hash hash') ## If the hashes are ## the same, a new ## #Collisions node ## is added. - (#Collisions hash (|> ## (array;new +2) + (#Collisions hash (|> ## (array.new +2) (: (Array [($ +0) ($ +1)]) - (array;new +2)) - (array;write +0 [key' val']) - (array;write +1 [key val]))) + (array.new +2)) + (array.write +0 [key' val']) + (array.write +1 [key val]))) ## Otherwise, I can ## just keep using ## #Base nodes, so I @@ -362,12 +362,12 @@ ## KV-pair as a singleton node to it. (#Hierarchy (n/inc base-count) (|> (promote-base put' Hash<k> level bitmap base) - (array;write (level-index level hash) + (array.write (level-index level hash) (put' (level-up level) hash key val Hash<k> empty)))) ## Otherwise, I just resize the #Base node to accommodate the ## new KV-pair. (#Base (set-bit-position bit bitmap) - (insert! (base-index bit bitmap) (#;Right [key val]) base)))))) + (insert! (base-index bit bitmap) (#.Right [key val]) base)))))) ## For #Collisions nodes, I compare the hashes. (#Collisions _hash _colls) @@ -377,19 +377,19 @@ (case (collision-index Hash<k> key _colls) ## If the key was already present in the collisions-list, it's ## value gets updated. - (#;Some coll-idx) + (#.Some coll-idx) (#Collisions _hash (update! coll-idx [key val] _colls)) ## Otherwise, the KV-pair is added to the collisions-list. - #;None - (#Collisions _hash (insert! (array;size _colls) [key val] _colls))) + #.None + (#Collisions _hash (insert! (array.size _colls) [key val] _colls))) ## If the hashes are not equal, I create a new #Base node that ## contains the old #Collisions node, plus the new KV-pair. (|> (#Base (bit-position level _hash) - (|> ## (array;new +1) + (|> ## (array.new +1) (: (Base ($ +0) ($ +1)) - (array;new +1)) - (array;write +0 (#;Left node)))) + (array.new +1)) + (array.write +0 (#.Left node)))) (put' level hash key val Hash<k>))) )) @@ -400,13 +400,13 @@ ## the Hash-Code. (#Hierarchy h-size h-array) (let [idx (level-index level hash)] - (case (array;read idx h-array) + (case (array.read idx h-array) ## If not, there's nothing to remove. - #;None + #.None node ## But if there is, try to remove the key from the sub-node. - (#;Some sub-node) + (#.Some sub-node) (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] ## Then check if a removal was actually done. (if (is sub-node sub-node') @@ -429,13 +429,13 @@ (let [bit (bit-position level hash)] (if (bit-position-is-set? bit bitmap) (let [idx (base-index bit bitmap)] - (case (array;read idx base) - #;None + (case (array.read idx base) + #.None (undefined) ## If set, check if it's a sub-node, and remove the KV ## from it. - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] ## Verify that it was removed. (if (is sub-node sub-node') @@ -454,10 +454,10 @@ ## But, if it did not come out empty, then the ## position is kept, and the node gets updated. (#Base bitmap - (update! idx (#;Left sub-node') base))))) + (update! idx (#.Left sub-node') base))))) ## If, however, there was a KV-pair instead of a sub-node. - (#;Some (#;Right [key' val'])) + (#.Some (#.Right [key' val'])) ## Check if the keys match. (if (:: Hash<k> = key key') ## If so, remove the KV-pair and unset the BitPosition. @@ -472,12 +472,12 @@ (#Collisions _hash _colls) (case (collision-index Hash<k> key _colls) ## If not, then there's nothing to remove. - #;None + #.None node ## But if so, then check the size of the collisions list. - (#;Some idx) - (if (n/= +1 (array;size _colls)) + (#.Some idx) + (if (n/= +1 (array.size _colls)) ## If there's only one left, then removing it leaves us with ## an empty node. empty @@ -490,31 +490,31 @@ (case node ## For #Hierarchy nodes, just look-up the key on its children. (#Hierarchy _size hierarchy) - (case (array;read (level-index level hash) hierarchy) - #;None #;None - (#;Some sub-node) (get' (level-up level) hash key Hash<k> sub-node)) + (case (array.read (level-index level hash) hierarchy) + #.None #.None + (#.Some sub-node) (get' (level-up level) hash key Hash<k> sub-node)) ## For #Base nodes, check the leaves, and recursively check the branches. (#Base bitmap base) (let [bit (bit-position level hash)] (if (bit-position-is-set? bit bitmap) - (case (array;read (base-index bit bitmap) base) - #;None + (case (array.read (base-index bit bitmap) base) + #.None (undefined) - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (get' (level-up level) hash key Hash<k> sub-node) - (#;Some (#;Right [key' val'])) + (#.Some (#.Right [key' val'])) (if (:: Hash<k> = key key') - (#;Some val') - #;None)) - #;None)) + (#.Some val') + #.None)) + #.None)) ## For #Collisions nodes, do a linear scan of all the known KV-pairs. (#Collisions _hash _colls) - (:: Monad<Maybe> map product;right - (array;find (|>> product;left (:: Hash<k> = key)) + (:: Monad<Maybe> map product.right + (array.find (|>> product.left (:: Hash<k> = key)) _colls)) )) @@ -527,12 +527,12 @@ (#Base _ base) (array/fold n/+ +0 (array/map (function [sub-node'] (case sub-node' - (#;Left sub-node) (size' sub-node) - (#;Right _) +1)) + (#.Left sub-node) (size' sub-node) + (#.Right _) +1)) base)) (#Collisions hash colls) - (array;size colls) + (array.size colls) )) (def: (entries' node) @@ -540,28 +540,28 @@ (case node (#Hierarchy _size hierarchy) (array/fold (function [sub-node tail] (list/compose (entries' sub-node) tail)) - #;Nil + #.Nil hierarchy) (#Base bitmap base) (array/fold (function [branch tail] (case branch - (#;Left sub-node) + (#.Left sub-node) (list/compose (entries' sub-node) tail) - (#;Right [key' val']) - (#;Cons [key' val'] tail))) - #;Nil + (#.Right [key' val']) + (#.Cons [key' val'] tail))) + #.Nil base) (#Collisions hash colls) - (array/fold (function [[key' val'] tail] (#;Cons [key' val'] tail)) - #;Nil + (array/fold (function [[key' val'] tail] (#.Cons [key' val'] tail)) + #.Nil colls))) ## [Exports] (type: #export (Dict k v) - {#;doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} + {#.doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} {#hash (Hash k) #root (Node k v)}) @@ -588,29 +588,29 @@ (def: #export (contains? key dict) (All [k v] (-> k (Dict k v) Bool)) (case (get key dict) - #;None false - (#;Some _) true)) + #.None false + (#.Some _) true)) (def: #export (put~ key val dict) - {#;doc "Only puts the KV-pair if the key is not already present."} + {#.doc "Only puts the KV-pair if the key is not already present."} (All [k v] (-> k v (Dict k v) (Dict k v))) (if (contains? key dict) dict (put key val dict))) (def: #export (update key f dict) - {#;doc "Transforms the value located at key (if available), using the given function."} + {#.doc "Transforms the value located at key (if available), using the given function."} (All [k v] (-> k (-> v v) (Dict k v) (Dict k v))) (case (get key dict) - #;None + #.None dict - (#;Some val) + (#.Some val) (put key (f val) dict))) (def: #export size (All [k v] (-> (Dict k v) Nat)) - (|>> product;right size')) + (|>> product.right size')) (def: #export empty? (All [k v] (-> (Dict k v) Bool)) @@ -618,7 +618,7 @@ (def: #export (entries dict) (All [k v] (-> (Dict k v) (List [k v]))) - (entries' (product;right dict))) + (entries' (product.right dict))) (def: #export (from-list Hash<k> kvs) (All [k v] (-> (Hash k) (List [k v]) (Dict k v))) @@ -632,12 +632,12 @@ (All [k v] (-> (Dict k v) (List <elem-type>))) (|> dict entries (list/map <side>)))] - [keys k product;left] - [values v product;right] + [keys k product.left] + [values v product.right] ) (def: #export (merge dict2 dict1) - {#;doc "Merges 2 dictionaries. + {#.doc "Merges 2 dictionaries. If any collisions with keys occur, the values of dict2 will overwrite those of dict1."} (All [k v] (-> (Dict k v) (Dict k v) (Dict k v))) @@ -646,16 +646,16 @@ (entries dict2))) (def: #export (merge-with f dict2 dict1) - {#;doc "Merges 2 dictionaries. + {#.doc "Merges 2 dictionaries. If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1."} (All [k v] (-> (-> v v v) (Dict k v) (Dict k v) (Dict k v))) (list/fold (function [[key val2] dict] (case (get key dict) - #;None + #.None (put key val2 dict) - (#;Some val1) + (#.Some val1) (put key (f val2 val1) dict))) dict1 (entries dict2))) @@ -663,22 +663,22 @@ (def: #export (re-bind from-key to-key dict) (All [k v] (-> k k (Dict k v) (Dict k v))) (case (get from-key dict) - #;None + #.None dict - (#;Some val) + (#.Some val) (|> dict (remove from-key) (put to-key val)))) (def: #export (select keys dict) - {#;doc "Creates a sub-set of the given dict, with only the specified keys."} + {#.doc "Creates a sub-set of the given dict, with only the specified keys."} (All [k v] (-> (List k) (Dict k v) (Dict k v))) (let [[Hash<k> _] dict] (list/fold (function [key new-dict] (case (get key dict) - #;None new-dict - (#;Some val) (put key val new-dict))) + #.None new-dict + (#.Some val) (put key val new-dict))) (new Hash<k>) keys))) @@ -687,9 +687,9 @@ (def: (= test subject) (and (n/= (size test) (size subject)) - (list;every? (function [k] + (list.every? (function [k] (case [(get k test) (get k subject)] - [(#;Some tk) (#;Some sk)] + [(#.Some tk) (#.Some sk)] (:: Eq<v> = tk sk) _ diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 28deea034..27f4e8bad 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [functor #+ Functor] @@ -16,13 +16,13 @@ ## (#Cons a (List a))) ## [Functions] -(struct: #export _ (fold;Fold List) +(struct: #export _ (fold.Fold List) (def: (fold f init xs) (case xs - #;Nil + #.Nil init - (#;Cons [x xs']) + (#.Cons [x xs']) (fold f (f x init) xs')))) (open Fold<List>) @@ -30,38 +30,38 @@ (def: #export (reverse xs) (All [a] (-> (List a) (List a))) - (fold (function [head tail] (#;Cons head tail)) - #;Nil + (fold (function [head tail] (#.Cons head tail)) + #.Nil xs)) (def: #export (filter p xs) (All [a] (-> (-> a Bool) (List a) (List a))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) - (#;Cons [x (filter p xs')]) + (#.Cons [x (filter p xs')]) (filter p xs')))) (def: #export (partition p xs) - {#;doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."} + {#.doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."} (All [a] (-> (-> a Bool) (List a) [(List a) (List a)])) [(filter p xs) (filter (complement p) xs)]) (def: #export (as-pairs xs) - {#;doc "Cut the list into pairs of 2. + {#.doc "Cut the list into pairs of 2. Caveat emptor: If the list has an uneven number of elements, the last one will be skipped."} (All [a] (-> (List a) (List [a a]))) (case xs - (^ (#;Cons [x1 (#;Cons [x2 xs'])])) - (#;Cons [[x1 x2] (as-pairs xs')]) + (^ (#.Cons [x1 (#.Cons [x2 xs'])])) + (#.Cons [[x1 x2] (as-pairs xs')]) _ - #;Nil)) + #.Nil)) (do-template [<name> <then> <else>] [(def: #export (<name> n xs) @@ -69,14 +69,14 @@ (-> Nat (List a) (List a))) (if (n/> +0 n) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [x xs']) + (#.Cons [x xs']) <then>) <else>))] - [take (#;Cons [x (take (n/dec n) xs')]) #;Nil] + [take (#.Cons [x (take (n/dec n) xs')]) #.Nil] [drop (drop (n/dec n) xs') xs] ) @@ -85,15 +85,15 @@ (All [a] (-> (-> a Bool) (List a) (List a))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) <then> <else>)))] - [take-while (#;Cons [x (take-while p xs')]) #;Nil] + [take-while (#.Cons [x (take-while p xs')]) #.Nil] [drop-while (drop-while p xs') xs] ) @@ -102,99 +102,99 @@ (-> Nat (List a) [(List a) (List a)])) (if (n/> +0 n) (case xs - #;Nil - [#;Nil #;Nil] + #.Nil + [#.Nil #.Nil] - (#;Cons [x xs']) + (#.Cons [x xs']) (let [[tail rest] (split (n/dec n) xs')] - [(#;Cons [x tail]) rest])) - [#;Nil xs])) + [(#.Cons [x tail]) rest])) + [#.Nil xs])) (def: (split-with' p ys xs) (All [a] (-> (-> a Bool) (List a) (List a) [(List a) (List a)])) (case xs - #;Nil + #.Nil [ys xs] - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) - (split-with' p (#;Cons [x ys]) xs') + (split-with' p (#.Cons [x ys]) xs') [ys xs]))) (def: #export (split-with p xs) - {#;doc "Segment the list by using a predicate to tell when to cut."} + {#.doc "Segment the list by using a predicate to tell when to cut."} (All [a] (-> (-> a Bool) (List a) [(List a) (List a)])) - (let [[ys' xs'] (split-with' p #;Nil xs)] + (let [[ys' xs'] (split-with' p #.Nil xs)] [(reverse ys') xs'])) (def: #export (split-all n xs) - {#;doc "Segment the list in chunks of size n."} + {#.doc "Segment the list in chunks of size n."} (All [a] (-> Nat (List a) (List (List a)))) (case xs - #;Nil + #.Nil (list) _ (let [[pre post] (split n xs)] - (#;Cons pre (split-all n post))))) + (#.Cons pre (split-all n post))))) (def: #export (repeat n x) - {#;doc "A list of the value x, repeated n times."} + {#.doc "A list of the value x, repeated n times."} (All [a] (-> Nat a (List a))) (if (n/> +0 n) - (#;Cons [x (repeat (n/dec n) x)]) - #;Nil)) + (#.Cons [x (repeat (n/dec n) x)]) + #.Nil)) (def: (iterate' f x) (All [a] (-> (-> a (Maybe a)) a (List a))) (case (f x) - (#;Some x') + (#.Some x') (list& x (iterate' f x')) - #;None + #.None (list))) (def: #export (iterate f x) - {#;doc "Generates a list element by element until the function returns #;None."} + {#.doc "Generates a list element by element until the function returns #.None."} (All [a] (-> (-> a (Maybe a)) a (List a))) (case (f x) - (#;Some x') + (#.Some x') (list& x (iterate' f x')) - #;None + #.None (list x))) (def: #export (find p xs) - {#;doc "Returns the first value in the list for which the predicate is true."} + {#.doc "Returns the first value in the list for which the predicate is true."} (All [a] (-> (-> a Bool) (List a) (Maybe a))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons [x xs']) + (#.Cons [x xs']) (if (p x) - (#;Some x) + (#.Some x) (find p xs')))) (def: #export (interpose sep xs) - {#;doc "Puts a value between every two elements in the list."} + {#.doc "Puts a value between every two elements in the list."} (All [a] (-> a (List a) (List a))) (case xs - #;Nil + #.Nil xs - (#;Cons [x #;Nil]) + (#.Cons [x #.Nil]) xs - (#;Cons [x xs']) - (#;Cons [x (#;Cons [sep (interpose sep xs')])]))) + (#.Cons [x xs']) + (#.Cons [x (#.Cons [sep (interpose sep xs')])]))) (def: #export (size list) (All [a] (-> (List a) Nat)) @@ -206,10 +206,10 @@ (-> (-> a Bool) (List a) Bool)) (loop [xs xs] (case xs - #;Nil + #.Nil <init> - (#;Cons x xs') + (#.Cons x xs') (case (p x) <init> (recur xs') @@ -222,16 +222,16 @@ ) (def: #export (nth i xs) - {#;doc "Fetches the element at the specified index."} + {#.doc "Fetches the element at the specified index."} (All [a] (-> Nat (List a) (Maybe a))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons [x xs']) + (#.Cons [x xs']) (if (n/= +0 i) - (#;Some x) + (#.Some x) (nth (n/dec i) xs')))) ## [Structures] @@ -239,10 +239,10 @@ (All [a] (-> (Eq a) (Eq (List a)))) (def: (= xs ys) (case [xs ys] - [#;Nil #;Nil] + [#.Nil #.Nil] true - [(#;Cons x xs') (#;Cons y ys')] + [(#.Cons x xs') (#.Cons y ys')] (and (:: Eq<a> = x y) (= xs' ys')) @@ -252,19 +252,19 @@ (struct: #export Monoid<List> (All [a] (Monoid (List a))) - (def: identity #;Nil) + (def: identity #.Nil) (def: (compose xs ys) (case xs - #;Nil ys - (#;Cons x xs') (#;Cons x (compose xs' ys))))) + #.Nil ys + (#.Cons x xs') (#.Cons x (compose xs' ys))))) (open Monoid<List>) (struct: #export _ (Functor List) (def: (map f ma) (case ma - #;Nil #;Nil - (#;Cons a ma') (#;Cons (f a) (map f ma'))))) + #.Nil #.Nil + (#.Cons a ma') (#.Cons (f a) (map f ma'))))) (open Functor<List>) @@ -272,14 +272,14 @@ (def: functor Functor<List>) (def: (wrap a) - (#;Cons a #;Nil)) + (#.Cons a #.Nil)) (def: (apply ff fa) (case ff - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons f ff') + (#.Cons f ff') (compose (map f fa) (apply ff' fa))))) (struct: #export _ (Monad List) @@ -291,21 +291,21 @@ (def: #export (sort < xs) (All [a] (-> (-> a a Bool) (List a) (List a))) (case xs - #;Nil + #.Nil (list) - (#;Cons x xs') + (#.Cons x xs') (let [[pre post] (fold (function [x' [pre post]] (if (< x x') - [(#;Cons x' pre) post] - [pre (#;Cons x' post)])) + [(#.Cons x' pre) post] + [pre (#.Cons x' post)])) [(list) (list)] xs')] ($_ compose (sort < pre) (list x) (sort < post))))) (do-template [<name> <type> <comp> <inc>] [(def: #export (<name> from to) - {#;doc "Generates an inclusive interval of values [from, to]."} + {#.doc "Generates an inclusive interval of values [from, to]."} (-> <type> <type> (List <type>)) (if (<comp> to from) (list& from (<name> (<inc> from) to)) @@ -318,26 +318,26 @@ (def: #export (empty? xs) (All [a] (-> (List a) Bool)) (case xs - #;Nil true + #.Nil true _ false)) (def: #export (member? eq xs x) (All [a] (-> (Eq a) (List a) a Bool)) (case xs - #;Nil false - (#;Cons x' xs') (or (:: eq = x x') + #.Nil false + (#.Cons x' xs') (or (:: eq = x x') (member? eq xs' x)))) (do-template [<name> <output> <side> <doc>] [(def: #export (<name> xs) - {#;doc <doc>} + {#.doc <doc>} (All [a] (-> (List a) (Maybe <output>))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons x xs') - (#;Some <side>)))] + (#.Cons x xs') + (#.Some <side>)))] [head a x "Returns the first element of a list."] [tail (List a) xs' "For a list of size N, returns the N-1 elements after the first one."] @@ -346,15 +346,15 @@ ## [Syntax] (def: (symbol$ name) (-> Text Code) - [["" +0 +0] (#;Symbol "" name)]) + [["" +0 +0] (#.Symbol "" name)]) (macro: #export (zip tokens state) - {#;doc (doc "Create list zippers with the specified number of input lists." + {#.doc (doc "Create list zippers with the specified number of input lists." (def: #export zip2 (zip +2)) (def: #export zip3 (zip +3)) ((zip +3) xs ys zs))} (case tokens - (^ (list [_ (#;Nat num-lists)])) + (^ (list [_ (#.Nat num-lists)])) (if (n/> +0 num-lists) (let [(^open) Functor<List> indices (n/range +0 (n/dec num-lists)) @@ -369,36 +369,36 @@ (let [base (nat/encode idx)] [(symbol$ base) (symbol$ ("lux text concat" base "'"))])))) - pattern (` [(~@ (map (function [[v vs]] (` (#;Cons (~ v) (~ vs)))) + pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") g!blank (symbol$ "\t_\t") - list-vars (map product;right vars+lists) + list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function (~ g!step) [(~@ list-vars)] (case [(~@ list-vars)] (~ pattern) - (#;Cons [(~@ (map product;left vars+lists))] + (#.Cons [(~@ (map product.left vars+lists))] ((~ g!step) (~@ list-vars))) (~ g!blank) - #;Nil))))] - (#;Right [state (list code)])) - (#;Left "Cannot zip 0 lists.")) + #.Nil))))] + (#.Right [state (list code)])) + (#.Left "Cannot zip 0 lists.")) _ - (#;Left "Wrong syntax for zip"))) + (#.Left "Wrong syntax for zip"))) (def: #export zip2 (zip +2)) (def: #export zip3 (zip +3)) (macro: #export (zip-with tokens state) - {#;doc (doc "Create list zippers with the specified number of input lists." + {#.doc (doc "Create list zippers with the specified number of input lists." (def: #export zip2-with (zip-with +2)) (def: #export zip3-with (zip-with +3)) ((zip-with +2) i/+ xs ys))} (case tokens - (^ (list [_ (#;Nat num-lists)])) + (^ (list [_ (#.Nat num-lists)])) (if (n/> +0 num-lists) (let [(^open) Functor<List> indices (n/range +0 (n/dec num-lists)) @@ -416,25 +416,25 @@ (let [base (nat/encode idx)] [(symbol$ base) (symbol$ ("lux text concat" base "'"))])))) - pattern (` [(~@ (map (function [[v vs]] (` (#;Cons (~ v) (~ vs)))) + pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") g!blank (symbol$ "\t_\t") - list-vars (map product;right vars+lists) + list-vars (map product.right vars+lists) code (` (: (~ zip-type) (function (~ g!step) [(~ g!func) (~@ list-vars)] (case [(~@ list-vars)] (~ pattern) - (#;Cons ((~ g!func) (~@ (map product;left vars+lists))) + (#.Cons ((~ g!func) (~@ (map product.left vars+lists))) ((~ g!step) (~ g!func) (~@ list-vars))) (~ g!blank) - #;Nil))))] - (#;Right [state (list code)])) - (#;Left "Cannot zip-with 0 lists.")) + #.Nil))))] + (#.Right [state (list code)])) + (#.Left "Cannot zip-with 0 lists.")) _ - (#;Left "Wrong syntax for zip-with"))) + (#.Left "Wrong syntax for zip-with"))) (def: #export zip2-with (zip-with +2)) (def: #export zip3-with (zip-with +3)) @@ -442,34 +442,34 @@ (def: #export (last xs) (All [a] (-> (List a) (Maybe a))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons x #;Nil) - (#;Some x) + (#.Cons x #.Nil) + (#.Some x) - (#;Cons x xs') + (#.Cons x xs') (last xs'))) (def: #export (inits xs) - {#;doc "For a list of size N, returns the first N-1 elements. + {#.doc "For a list of size N, returns the first N-1 elements. - Empty lists will result in a #;None value being returned instead."} + Empty lists will result in a #.None value being returned instead."} (All [a] (-> (List a) (Maybe (List a)))) (case xs - #;Nil - #;None + #.Nil + #.None - (#;Cons x #;Nil) - (#;Some #;Nil) + (#.Cons x #.Nil) + (#.Some #.Nil) - (#;Cons x xs') + (#.Cons x xs') (case (inits xs') - #;None + #.None (undefined) - (#;Some tail) - (#;Some (#;Cons x tail))) + (#.Some tail) + (#.Some (#.Cons x tail))) )) (def: #export (concat xss) @@ -478,36 +478,36 @@ (struct: #export (ListT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) - (def: applicative (applicative;compose (get@ #monad;applicative Monad<M>) Applicative<List>)) + (def: applicative (applicative.compose (get@ #monad.applicative Monad<M>) Applicative<List>)) (def: (join MlMla) (do Monad<M> [lMla MlMla lla (: (($ +0) (List (List ($ +1)))) - (monad;seq @ lMla)) - ## lla (monad;seq @ lMla) + (monad.seq @ lMla)) + ## lla (monad.seq @ lMla) ] (wrap (concat lla))))) (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) - (monad;lift Monad<M> (:: Monad<List> wrap))) + (monad.lift Monad<M> (:: Monad<List> wrap))) (def: (enumerate' idx xs) (All [a] (-> Nat (List a) (List [Nat a]))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons x xs') - (#;Cons [idx x] (enumerate' (n/inc idx) xs')))) + (#.Cons x xs') + (#.Cons [idx x] (enumerate' (n/inc idx) xs')))) (def: #export (enumerate xs) - {#;doc "Pairs every element in the list with it's index, starting at 0."} + {#.doc "Pairs every element in the list with its index, starting at 0."} (All [a] (-> (List a) (List [Nat a]))) (enumerate' +0 xs)) (def: #export (indices size) - {#;doc "Produces all the valid indices for a given size."} + {#.doc "Produces all the valid indices for a given size."} (All [a] (-> Nat (List Nat))) (if (n/= +0 size) (list) diff --git a/stdlib/source/lux/data/coll/ordered/dict.lux b/stdlib/source/lux/data/coll/ordered/dict.lux index ecf661b15..b011bc366 100644 --- a/stdlib/source/lux/data/coll/ordered/dict.lux +++ b/stdlib/source/lux/data/coll/ordered/dict.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] eq @@ -41,7 +41,7 @@ (def: #export (new Order<k>) (All [k v] (-> (Order k) (Dict k v))) {#order Order<k> - #root #;None}) + #root #.None}) ## TODO: Doing inneficient access of Order functions due to compiler bug. ## TODO: Must improve it as soon as bug is fixed. @@ -51,14 +51,14 @@ ] (loop [node (get@ #root dict)] (case node - #;None - #;None + #.None + #.None - (#;Some node) + (#.Some node) (let [node-key (get@ #key node)] (cond (:: dict = node-key key) ## (T/= node-key key) - (#;Some (get@ #value node)) + (#.Some (get@ #value node)) (:: dict < node-key key) ## (T/< node-key key) @@ -74,10 +74,10 @@ ] (loop [node (get@ #root dict)] (case node - #;None + #.None false - (#;Some node) + (#.Some node) (let [node-key (get@ #key node)] (or (:: dict = node-key key) ## (T/= node-key key) @@ -90,16 +90,16 @@ [(def: #export (<name> dict) (All [k v] (-> (Dict k v) (Maybe v))) (case (get@ #root dict) - #;None - #;None + #.None + #.None - (#;Some node) + (#.Some node) (loop [node node] (case (get@ <side> node) - #;None - (#;Some (get@ #value node)) + #.None + (#.Some (get@ #value node)) - (#;Some side) + (#.Some side) (recur side)))))] [min #left] @@ -111,10 +111,10 @@ (All [k v] (-> (Dict k v) Nat)) (loop [node (get@ #root dict)] (case node - #;None + #.None +0 - (#;Some node) + (#.Some node) (n/inc (<op> (recur (get@ #left node)) (recur (get@ #right node)))))))] @@ -142,32 +142,32 @@ (with-expansions [<default-behavior> (as-is (black (get@ #key parent) (get@ #value parent) - (#;Some self) + (#.Some self) (get@ #right parent)))] (case (get@ #color self) #Red (case (get@ #left self) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red]) (red (get@ #key self) (get@ #value self) - (#;Some (blacken left)) - (#;Some (black (get@ #key parent) + (#.Some (blacken left)) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #right self) (get@ #right parent)))) _ (case (get@ #right self) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red]) (red (get@ #key right) (get@ #value right) - (#;Some (black (get@ #key self) + (#.Some (black (get@ #key self) (get@ #value self) (get@ #left self) (get@ #left right))) - (#;Some (black (get@ #key parent) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #right right) (get@ #right parent)))) @@ -185,31 +185,31 @@ [<default-behavior> (as-is (black (get@ #key parent) (get@ #value parent) (get@ #left parent) - (#;Some self)))] + (#.Some self)))] (case (get@ #color self) #Red (case (get@ #right self) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red]) (red (get@ #key self) (get@ #value self) - (#;Some (black (get@ #key parent) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #left parent) (get@ #left self))) - (#;Some (blacken right))) + (#.Some (blacken right))) _ (case (get@ #left self) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red]) (red (get@ #key left) (get@ #value left) - (#;Some (black (get@ #key parent) + (#.Some (black (get@ #key parent) (get@ #value parent) (get@ #left parent) (get@ #left left))) - (#;Some (black (get@ #key self) + (#.Some (black (get@ #key self) (get@ #value self) (get@ #right left) (get@ #right self)))) @@ -225,7 +225,7 @@ (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red - (red (get@ #key center) (get@ #value center) (#;Some addition) (get@ #right center)) + (red (get@ #key center) (get@ #value center) (#.Some addition) (get@ #right center)) #Black (balance-left-add center addition) @@ -235,7 +235,7 @@ (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red - (red (get@ #key center) (get@ #value center) (get@ #left center) (#;Some addition)) + (red (get@ #key center) (get@ #value center) (get@ #left center) (#.Some addition)) #Black (balance-right-add center addition) @@ -246,10 +246,10 @@ (let [(^open "T/") (get@ #order dict) root' (loop [?root (get@ #root dict)] (case ?root - #;None - (#;Some (red key value #;None #;None)) + #.None + (#.Some (red key value #.None #.None)) - (#;Some root) + (#.Some root) (let [reference (get@ #key root)] (`` (cond (~~ (do-template [<comp> <tag> <add>] [(<comp> reference key) @@ -257,7 +257,7 @@ outcome (recur side-root)] (if (is side-root outcome) ?root - (#;Some (<add> (maybe;assume outcome) + (#.Some (<add> (maybe.assume outcome) root))))] [T/< #left add-left] @@ -273,27 +273,27 @@ (def: (left-balance key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?left - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red] - [(get@ #left left) (#;Some left.left)] - [(get@ #color left.left) #Red]) + [(get@ #left left) (#.Some left>>left)] + [(get@ #color left>>left) #Red]) (red (get@ #key left) (get@ #value left) - (#;Some (blacken left.left)) - (#;Some (black key value (get@ #right left) ?right))) + (#.Some (blacken left>>left)) + (#.Some (black key value (get@ #right left) ?right))) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red] - [(get@ #right left) (#;Some left.right)] - [(get@ #color left.right) #Red]) - (red (get@ #key left.right) - (get@ #value left.right) - (#;Some (black (get@ #key left) + [(get@ #right left) (#.Some left>>right)] + [(get@ #color left>>right) #Red]) + (red (get@ #key left>>right) + (get@ #value left>>right) + (#.Some (black (get@ #key left) (get@ #value left) (get@ #left left) - (get@ #left left.right))) - (#;Some (black key value - (get@ #right left.right) + (get@ #left left>>right))) + (#.Some (black key value + (get@ #right left>>right) ?right))) _ @@ -302,25 +302,25 @@ (def: (right-balance key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?right - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red] - [(get@ #right right) (#;Some right.right)] - [(get@ #color right.right) #Red]) + [(get@ #right right) (#.Some right>>right)] + [(get@ #color right>>right) #Red]) (red (get@ #key right) (get@ #value right) - (#;Some (black key value ?left (get@ #left right))) - (#;Some (blacken right.right))) + (#.Some (black key value ?left (get@ #left right))) + (#.Some (blacken right>>right))) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red] - [(get@ #left right) (#;Some right.left)] - [(get@ #color right.left) #Red]) - (red (get@ #key right.left) - (get@ #value right.left) - (#;Some (black key value ?left (get@ #left right.left))) - (#;Some (black (get@ #key right) + [(get@ #left right) (#.Some right>>left)] + [(get@ #color right>>left) #Red]) + (red (get@ #key right>>left) + (get@ #value right>>left) + (#.Some (black key value ?left (get@ #left right>>left))) + (#.Some (black (get@ #key right) (get@ #value right) - (get@ #right right.left) + (get@ #right right>>left) (get@ #right right)))) _ @@ -329,27 +329,27 @@ (def: (balance-left-remove key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?left - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red]) - (red key value (#;Some (blacken left)) ?right) + (red key value (#.Some (blacken left)) ?right) _ (case ?right - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Black]) - (right-balance key value ?left (#;Some (redden right))) + (right-balance key value ?left (#.Some (redden right))) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red] - [(get@ #left right) (#;Some right.left)] - [(get@ #color right.left) #Black]) - (red (get@ #key right.left) - (get@ #value right.left) - (#;Some (black key value ?left (get@ #left right.left))) - (#;Some (right-balance (get@ #key right) + [(get@ #left right) (#.Some right>>left)] + [(get@ #color right>>left) #Black]) + (red (get@ #key right>>left) + (get@ #value right>>left) + (#.Some (black key value ?left (get@ #left right>>left))) + (#.Some (right-balance (get@ #key right) (get@ #value right) - (get@ #right right.left) - (:: maybe;Functor<Maybe> map redden (get@ #right right))))) + (get@ #right right>>left) + (:: maybe.Functor<Maybe> map redden (get@ #right right))))) _ (error! error-message)) @@ -358,27 +358,27 @@ (def: (balance-right-remove key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?right - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Red]) - (red key value ?left (#;Some (blacken right))) + (red key value ?left (#.Some (blacken right))) _ (case ?left - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Black]) - (left-balance key value (#;Some (redden left)) ?right) + (left-balance key value (#.Some (redden left)) ?right) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Red] - [(get@ #right left) (#;Some left.right)] - [(get@ #color left.right) #Black]) - (red (get@ #key left.right) - (get@ #value left.right) - (#;Some (left-balance (get@ #key left) + [(get@ #right left) (#.Some left>>right)] + [(get@ #color left>>right) #Black]) + (red (get@ #key left>>right) + (get@ #value left>>right) + (#.Some (left-balance (get@ #key left) (get@ #value left) - (:: maybe;Functor<Maybe> map redden (get@ #left left)) - (get@ #left left.right))) - (#;Some (black key value (get@ #right left.right) ?right))) + (:: maybe.Functor<Maybe> map redden (get@ #left left)) + (get@ #left left>>right))) + (#.Some (black key value (get@ #right left>>right) ?right))) _ (error! error-message) @@ -387,26 +387,26 @@ (def: (prepend ?left ?right) (All [k v] (-> (Maybe (Node k v)) (Maybe (Node k v)) (Maybe (Node k v)))) (case [?left ?right] - [#;None _] + [#.None _] ?right - [_ #;None] + [_ #.None] ?left - [(#;Some left) (#;Some right)] + [(#.Some left) (#.Some right)] (case [(get@ #color left) (get@ #color right)] [#Red #Red] - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fused (prepend (get@ #right left) (get@ #right right))] (case (get@ #color fused) #Red (wrap (red (get@ #key fused) (get@ #value fused) - (#;Some (red (get@ #key left) + (#.Some (red (get@ #key left) (get@ #value left) (get@ #left left) (get@ #left fused))) - (#;Some (red (get@ #key right) + (#.Some (red (get@ #key right) (get@ #value right) (get@ #right fused) (get@ #right right))))) @@ -415,37 +415,37 @@ (wrap (red (get@ #key left) (get@ #value left) (get@ #left left) - (#;Some (red (get@ #key right) + (#.Some (red (get@ #key right) (get@ #value right) - (#;Some fused) + (#.Some fused) (get@ #right right))))))) [#Red #Black] - (#;Some (red (get@ #key left) + (#.Some (red (get@ #key left) (get@ #value left) (get@ #left left) (prepend (get@ #right left) ?right))) [#Black #Red] - (#;Some (red (get@ #key right) + (#.Some (red (get@ #key right) (get@ #value right) (prepend ?left (get@ #left right)) (get@ #right right))) [#Black #Black] - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fused (prepend (get@ #right left) (get@ #left right))] (case (get@ #color fused) #Red (wrap (red (get@ #key fused) (get@ #value fused) - (#;Some (black (get@ #key left) + (#.Some (black (get@ #key left) (get@ #value left) (get@ #left left) (get@ #left fused))) - (#;Some (black (get@ #key right) + (#.Some (black (get@ #key right) (get@ #value right) (get@ #right fused) (get@ #right right))))) @@ -454,9 +454,9 @@ (wrap (balance-left-remove (get@ #key left) (get@ #value left) (get@ #left left) - (#;Some (black (get@ #key right) + (#.Some (black (get@ #key right) (get@ #value right) - (#;Some fused) + (#.Some fused) (get@ #right right))))) )) ))) @@ -466,10 +466,10 @@ (let [(^open "T/") (get@ #order dict) [?root found?] (loop [?root (get@ #root dict)] (case ?root - #;None - [#;None false] + #.None + [#.None false] - (#;Some root) + (#.Some root) (let [root-key (get@ #key root) root-val (get@ #value root)] (if (T/= root-key key) @@ -480,40 +480,40 @@ (case (recur (if go-left? (get@ #left root) (get@ #right root))) - [#;None false] - [#;None false] + [#.None false] + [#.None false] [side-outcome _] (if go-left? (case (get@ #left root) - (^multi (#;Some left) + (^multi (#.Some left) [(get@ #color left) #Black]) - [(#;Some (balance-left-remove root-key root-val side-outcome (get@ #right root))) + [(#.Some (balance-left-remove root-key root-val side-outcome (get@ #right root))) false] _ - [(#;Some (red root-key root-val side-outcome (get@ #right root))) + [(#.Some (red root-key root-val side-outcome (get@ #right root))) false]) (case (get@ #right root) - (^multi (#;Some right) + (^multi (#.Some right) [(get@ #color right) #Black]) - [(#;Some (balance-right-remove root-key root-val (get@ #left root) side-outcome)) + [(#.Some (balance-right-remove root-key root-val (get@ #left root) side-outcome)) false] _ - [(#;Some (red root-key root-val (get@ #left root) side-outcome)) + [(#.Some (red root-key root-val (get@ #left root) side-outcome)) false]) ))) )) ))] (case ?root - #;None + #.None (if found? (set@ #root ?root dict) dict) - (#;Some root) - (set@ #root (#;Some (blacken root)) dict) + (#.Some root) + (set@ #root (#.Some (blacken root)) dict) ))) (def: #export (from-list Order<l> list) @@ -528,10 +528,10 @@ (All [k v] (-> (Dict k v) (List <type>))) (loop [node (get@ #root dict)] (case node - #;None + #.None (list) - (#;Some node') + (#.Some node') ($_ L/compose (recur (get@ #left node')) (list <output>) @@ -548,10 +548,10 @@ (loop [entriesR (entries reference) entriesS (entries sample)] (case [entriesR entriesS] - [#;Nil #;Nil] + [#.Nil #.Nil] true - [(#;Cons [keyR valueR] entriesR') (#;Cons [keyS valueS] entriesS')] + [(#.Cons [keyR valueR] entriesR') (#.Cons [keyS valueS] entriesS')] (and (:: Eq<k> = keyR keyS) (:: Eq<v> = valueR valueS) (recur entriesR' entriesS')) diff --git a/stdlib/source/lux/data/coll/ordered/set.lux b/stdlib/source/lux/data/coll/ordered/set.lux index a8f5ed45d..5d6ba5478 100644 --- a/stdlib/source/lux/data/coll/ordered/set.lux +++ b/stdlib/source/lux/data/coll/ordered/set.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] eq @@ -12,23 +12,23 @@ ["s" syntax #+ syntax: Syntax]))) (type: #export (Set a) - (d;Dict a a)) + (d.Dict a a)) (def: #export new (All [a] (-> (Order a) (Set a))) - d;new) + d.new) (def: #export (member? set elem) (All [a] (-> (Set a) a Bool)) - (d;contains? elem set)) + (d.contains? elem set)) (do-template [<name> <alias>] [(def: #export (<name> set) (All [a] (-> (Set a) (Maybe a))) (<alias> set))] - [min d;min] - [max d;max] + [min d.min] + [max d.max] ) (do-template [<name> <alias>] @@ -36,17 +36,17 @@ (All [a] (-> (Set a) Nat)) (<alias> set))] - [size d;size] - [depth d;depth] + [size d.size] + [depth d.depth] ) (def: #export (add elem set) (All [a] (-> a (Set a) (Set a))) - (d;put elem elem set)) + (d.put elem elem set)) (def: #export (remove elem set) (All [a] (-> a (Set a) (Set a))) - (d;remove elem set)) + (d.remove elem set)) (def: #export (from-list Order<a> list) (All [a] (-> (Order a) (List a) (Set a))) @@ -54,7 +54,7 @@ (def: #export (to-list set) (All [a] (-> (Set a) (List a))) - (d;keys set)) + (d.keys set)) (def: #export (union left right) (All [a] (-> (Set a) (Set a) (Set a))) @@ -63,18 +63,18 @@ (def: #export (intersection left right) (All [a] (-> (Set a) (Set a) (Set a))) (|> (to-list right) - (list;filter (member? left)) - (from-list (get@ #d;order right)))) + (list.filter (member? left)) + (from-list (get@ #d.order right)))) (def: #export (difference param subject) (All [a] (-> (Set a) (Set a) (Set a))) (|> (to-list subject) - (list;filter (|>> (member? param) not)) - (from-list (get@ #d;order subject)))) + (list.filter (|>> (member? param) not)) + (from-list (get@ #d.order subject)))) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bool)) - (list;every? (member? super) (to-list sub))) + (list.every? (member? super) (to-list sub))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bool)) @@ -82,5 +82,5 @@ (struct: #export Eq<Set> (All [a] (Eq (Set a))) (def: (= reference sample) - (:: (list;Eq<List> (:: sample eq)) + (:: (list.Eq<List> (:: sample eq)) = (to-list reference) (to-list sample)))) diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux index 5e270518d..833d3b3e1 100644 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ b/stdlib/source/lux/data/coll/priority-queue.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] [monad #+ do Monad]) @@ -9,94 +9,94 @@ (type: #export Priority Nat) (type: #export (Queue a) - (Maybe (F;Fingers Priority a))) + (Maybe (F.Fingers Priority a))) (def: max-priority Priority ("lux nat max")) (def: min-priority Priority ("lux nat min")) (def: #export empty Queue - #;None) + #.None) (def: #export (peek queue) (All [a] (-> (Queue a) (Maybe a))) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fingers queue] - (wrap (maybe;assume (F;search (n/= (F;tag fingers)) fingers))))) + (wrap (maybe.assume (F.search (n/= (F.tag fingers)) fingers))))) (def: #export (size queue) (All [a] (-> (Queue a) Nat)) (case queue - #;None + #.None +0 - (#;Some fingers) - (loop [node (get@ #F;tree fingers)] + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] (case node - (#F;Leaf _ _) + (#F.Leaf _ _) +1 - (#F;Branch _ left right) + (#F.Branch _ left right) (n/+ (recur left) (recur right)))))) (def: #export (member? Eq<a> queue member) (All [a] (-> (Eq a) (Queue a) a Bool)) (case queue - #;None + #.None false - (#;Some fingers) - (loop [node (get@ #F;tree fingers)] + (#.Some fingers) + (loop [node (get@ #F.tree fingers)] (case node - (#F;Leaf _ reference) + (#F.Leaf _ reference) (:: Eq<a> = reference member) - (#F;Branch _ left right) + (#F.Branch _ left right) (or (recur left) (recur right)))))) (def: #export (pop queue) (All [a] (-> (Queue a) (Queue a))) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [fingers queue - #let [highest-priority (F;tag fingers)] - node' (loop [node (get@ #F;tree fingers)] + #let [highest-priority (F.tag fingers)] + node' (loop [node (get@ #F.tree fingers)] (case node - (#F;Leaf priority reference) + (#F.Leaf priority reference) (if (n/= highest-priority priority) - #;None - (#;Some node)) + #.None + (#.Some node)) - (#F;Branch priority left right) - (if (n/= highest-priority (F;tag (set@ #F;tree left fingers))) + (#F.Branch priority left right) + (if (n/= highest-priority (F.tag (set@ #F.tree left fingers))) (case (recur left) - #;None - (#;Some right) - - (#;Some =left) - (|> (F;branch (set@ #F;tree =left fingers) - (set@ #F;tree right fingers)) - (get@ #F;tree) - #;Some)) + #.None + (#.Some right) + + (#.Some =left) + (|> (F.branch (set@ #F.tree =left fingers) + (set@ #F.tree right fingers)) + (get@ #F.tree) + #.Some)) (case (recur right) - #;None - (#;Some left) - - (#;Some =right) - (|> (F;branch (set@ #F;tree left fingers) - (set@ #F;tree =right fingers)) - (get@ #F;tree) - #;Some)) + #.None + (#.Some left) + + (#.Some =right) + (|> (F.branch (set@ #F.tree left fingers) + (set@ #F.tree =right fingers)) + (get@ #F.tree) + #.Some)) )))] - (wrap (set@ #F;tree node' fingers)))) + (wrap (set@ #F.tree node' fingers)))) (def: #export (push priority value queue) (All [a] (-> Priority a (Queue a) (Queue a))) - (let [addition {#F;monoid number;Max@Monoid<Nat> - #F;tree (#F;Leaf priority value)}] + (let [addition {#F.monoid number.Max@Monoid<Nat> + #F.tree (#F.Leaf priority value)}] (case queue - #;None - (#;Some addition) + #.None + (#.Some addition) - (#;Some fingers) - (#;Some (F;branch fingers addition))))) + (#.Some fingers) + (#.Some (F.branch fingers addition))))) diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux index 2d45dd995..2f48d3035 100644 --- a/stdlib/source/lux/data/coll/queue.lux +++ b/stdlib/source/lux/data/coll/queue.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] ["F" functor]) @@ -21,27 +21,27 @@ (def: #export (to-list queue) (All [a] (-> (Queue a) (List a))) (let [(^slots [#front #rear]) queue] - (L/compose front (list;reverse rear)))) + (L/compose front (list.reverse rear)))) (def: #export peek (All [a] (-> (Queue a) (Maybe a))) - (|>> (get@ #front) list;head)) + (|>> (get@ #front) list.head)) (def: #export (size queue) (All [a] (-> (Queue a) Nat)) (let [(^slots [#front #rear]) queue] - (n/+ (list;size front) - (list;size rear)))) + (n/+ (list.size front) + (list.size rear)))) (def: #export empty? (All [a] (-> (Queue a) Bool)) - (|>> (get@ #front) list;empty?)) + (|>> (get@ #front) list.empty?)) (def: #export (member? Eq<a> queue member) (All [a] (-> (Eq a) (Queue a) a Bool)) (let [(^slots [#front #rear]) queue] - (or (list;member? Eq<a> front member) - (list;member? Eq<a> rear member)))) + (or (list.member? Eq<a> front member) + (list.member? Eq<a> rear member)))) (def: #export (pop queue) (All [a] (-> (Queue a) (Queue a))) @@ -51,7 +51,7 @@ (^ (list _)) ## Front has dried up... (|> queue - (set@ #front (list;reverse (get@ #rear queue))) + (set@ #front (list.reverse (get@ #rear queue))) (set@ #rear (list))) (^ (list& _ front')) ## Consume front! @@ -61,18 +61,18 @@ (def: #export (push val queue) (All [a] (-> a (Queue a) (Queue a))) (case (get@ #front queue) - #;Nil + #.Nil (set@ #front (list val) queue) _ - (update@ #rear (|>> (#;Cons val)) queue))) + (update@ #rear (|>> (#.Cons val)) queue))) (struct: #export (Eq<Queue> Eq<a>) (All [a] (-> (Eq a) (Eq (Queue a)))) (def: (= qx qy) - (:: (list;Eq<List> Eq<a>) = (to-list qx) (to-list qy)))) + (:: (list.Eq<List> Eq<a>) = (to-list qx) (to-list qy)))) -(struct: #export _ (F;Functor Queue) +(struct: #export _ (F.Functor Queue) (def: (map f fa) {#front (|> fa (get@ #front) (L/map f)) #rear (|> fa (get@ #rear) (L/map f))})) diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index b97a51450..e5d2717fc 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -48,7 +48,7 @@ (def: full-node-size Nat - (bit;shift-left branching-exponent +1)) + (bit.shift-left branching-exponent +1)) (def: branch-idx-mask Nat @@ -56,19 +56,19 @@ (def: branch-idx (-> Index Index) - (bit;and branch-idx-mask)) + (bit.and branch-idx-mask)) (def: (new-hierarchy _) (All [a] (-> Top (Hierarchy a))) - (array;new full-node-size)) + (array.new full-node-size)) (def: (tail-off vec-size) (-> Nat Nat) (if (n/< full-node-size vec-size) +0 (|> (n/dec vec-size) - (bit;shift-right branching-exponent) - (bit;shift-left branching-exponent)))) + (bit.shift-right branching-exponent) + (bit.shift-left branching-exponent)))) (def: (new-path level tail) (All [a] (-> Level (Base a) (Node a))) @@ -77,61 +77,61 @@ (|> ## (new-hierarchy []) (: (Hierarchy ($ +0)) (new-hierarchy [])) - (array;write +0 (new-path (level-down level) tail)) + (array.write +0 (new-path (level-down level) tail)) #Hierarchy))) (def: (new-tail singleton) (All [a] (-> a (Base a))) - (|> ## (array;new +1) + (|> ## (array.new +1) (: (Base ($ +0)) - (array;new +1)) - (array;write +0 singleton))) + (array.new +1)) + (array.write +0 singleton))) (def: (push-tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;shift-right level (n/dec size))) + (let [sub-idx (branch-idx (bit.shift-right level (n/dec size))) ## If we're currently on a bottom node sub-node (if (n/= branching-exponent level) ## Just add the tail to it (#Base tail) ## Otherwise, check whether there's a vacant spot - (case (array;read sub-idx parent) + (case (array.read sub-idx parent) ## If so, set the path to the tail - #;None + #.None (new-path (level-down level) tail) ## If not, push the tail onto the sub-node. - (#;Some (#Hierarchy sub-node)) + (#.Some (#Hierarchy sub-node)) (#Hierarchy (push-tail size (level-down level) tail sub-node)) _ (undefined)) )] - (|> (array;clone parent) - (array;write sub-idx sub-node)))) + (|> (array.clone parent) + (array.write sub-idx sub-node)))) (def: (expand-tail val tail) (All [a] (-> a (Base a) (Base a))) - (let [tail-size (array;size tail)] - (|> ## (array;new (n/inc tail-size)) + (let [tail-size (array.size tail)] + (|> ## (array.new (n/inc tail-size)) (: (Base ($ +0)) - (array;new (n/inc tail-size))) - (array;copy tail-size +0 tail +0) - (array;write tail-size val) + (array.new (n/inc tail-size))) + (array.copy tail-size +0 tail +0) + (array.write tail-size val) ))) (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (bit;shift-right level idx))] - (case (array;read sub-idx hierarchy) - (#;Some (#Hierarchy sub-node)) - (|> (array;clone hierarchy) - (array;write sub-idx (#Hierarchy (put' (level-down level) idx val sub-node)))) + (let [sub-idx (branch-idx (bit.shift-right level idx))] + (case (array.read sub-idx hierarchy) + (#.Some (#Hierarchy sub-node)) + (|> (array.clone hierarchy) + (array.write sub-idx (#Hierarchy (put' (level-down level) idx val sub-node)))) - (^multi (#;Some (#Base base)) + (^multi (#.Some (#Base base)) (n/= +0 (level-down level))) - (|> (array;clone hierarchy) - (array;write sub-idx (|> (array;clone base) - (array;write (branch-idx idx) val) + (|> (array.clone hierarchy) + (array.write sub-idx (|> (array.clone base) + (array.write (branch-idx idx) val) #Base))) _ @@ -139,41 +139,41 @@ (def: (pop-tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (bit;shift-right level (n/- +2 size)))] + (let [sub-idx (branch-idx (bit.shift-right level (n/- +2 size)))] (cond (n/= +0 sub-idx) - #;None + #.None (n/> branching-exponent level) - (do maybe;Monad<Maybe> - [base|hierarchy (array;read sub-idx hierarchy) + (do maybe.Monad<Maybe> + [base|hierarchy (array.read sub-idx hierarchy) sub (case base|hierarchy (#Hierarchy sub) (pop-tail size (level-down level) sub) (#Base _) (undefined))] - (|> (array;clone hierarchy) - (array;write sub-idx (#Hierarchy sub)) - #;Some)) + (|> (array.clone hierarchy) + (array.write sub-idx (#Hierarchy sub)) + #.Some)) ## Else... - (|> (array;clone hierarchy) - (array;delete sub-idx) - #;Some) + (|> (array.clone hierarchy) + (array.delete sub-idx) + #.Some) ))) (def: (to-list' node) (All [a] (-> (Node a) (List a))) (case node (#Base base) - (array;to-list base) + (array.to-list base) (#Hierarchy hierarchy) (|> hierarchy - array;to-list - list;reverse + array.to-list + list.reverse (list/fold (function [sub acc] (list/compose (to-list' sub) acc)) - #;Nil)))) + #.Nil)))) ## [Types] (type: #export (Sequence a) @@ -187,8 +187,8 @@ Sequence {#level (level-up root-level) #size +0 - #root (array;new full-node-size) - #tail (array;new +0)}) + #root (array.new full-node-size) + #tail (array.new +0)}) (def: #export (size sequence) (All [a] (-> (Sequence a) Nat)) @@ -206,16 +206,16 @@ ## Otherwise, push tail into the tree ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? - (|> (if (n/> (bit;shift-left (get@ #level vec) +1) - (bit;shift-right branching-exponent vec-size)) + (|> (if (n/> (bit.shift-left (get@ #level vec) +1) + (bit.shift-right branching-exponent vec-size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> vec (set@ #root (|> ## (new-hierarchy []) (: (Hierarchy ($ +0)) (new-hierarchy [])) - (array;write +0 (#Hierarchy (get@ #root vec))) - (array;write +1 (new-path (get@ #level vec) (get@ #tail vec))))) + (array.write +0 (#Hierarchy (get@ #root vec))) + (array.write +1 (new-path (get@ #level vec) (get@ #tail vec))))) (update@ #level level-up)) ## Otherwise, just push the current tail onto the root. (|> vec @@ -232,29 +232,29 @@ (if (and (n/>= +0 idx) (n/< vec-size idx)) (if (n/>= (tail-off vec-size) idx) - (#;Some (get@ #tail vec)) + (#.Some (get@ #tail vec)) (loop [level (get@ #level vec) hierarchy (get@ #root vec)] (case [(n/> branching-exponent level) - (array;read (branch-idx (bit;shift-right level idx)) hierarchy)] - [true (#;Some (#Hierarchy sub))] + (array.read (branch-idx (bit.shift-right level idx)) hierarchy)] + [true (#.Some (#Hierarchy sub))] (recur (level-down level) sub) - [false (#;Some (#Base base))] - (#;Some base) + [false (#.Some (#Base base))] + (#.Some base) - [_ #;None] - #;None + [_ #.None] + #.None _ (error! "Incorrect sequence structure.")))) - #;None))) + #.None))) (def: #export (nth idx vec) (All [a] (-> Nat (Sequence a) (Maybe a))) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [base (base-for idx vec)] - (array;read (branch-idx idx) base))) + (array.read (branch-idx idx) base))) (def: #export (put idx val vec) (All [a] (-> Nat a (Sequence a) (Sequence a))) @@ -263,9 +263,9 @@ (n/< vec-size idx)) (if (n/>= (tail-off vec-size) idx) (|> vec - ## (update@ #tail (|>> array;clone (array;write (branch-idx idx) val))) + ## (update@ #tail (|>> array.clone (array.write (branch-idx idx) val))) (update@ #tail (: (-> (Base ($ +0)) (Base ($ +0))) - (|>> array;clone (array;write (branch-idx idx) val)))) + (|>> array.clone (array.write (branch-idx idx) val)))) ) (|> vec (update@ #root (put' (get@ #level vec) idx val)))) @@ -274,10 +274,10 @@ (def: #export (update idx f vec) (All [a] (-> Nat (-> a a) (Sequence a) (Sequence a))) (case (nth idx vec) - (#;Some val) + (#.Some val) (put idx (f val) vec) - #;None + #.None vec)) (def: #export (pop vec) @@ -292,28 +292,28 @@ vec-size (if (|> vec-size (n/- (tail-off vec-size)) (n/> +1)) (let [old-tail (get@ #tail vec) - new-tail-size (n/dec (array;size old-tail))] + new-tail-size (n/dec (array.size old-tail))] (|> vec (update@ #size n/dec) - (set@ #tail (|> (array;new new-tail-size) - (array;copy new-tail-size +0 old-tail +0))))) - (maybe;assume - (do maybe;Monad<Maybe> + (set@ #tail (|> (array.new new-tail-size) + (array.copy new-tail-size +0 old-tail +0))))) + (maybe.assume + (do maybe.Monad<Maybe> [new-tail (base-for (n/- +2 vec-size) vec) #let [## [level' root'] (let [init-level (get@ #level vec)] ## (loop [level init-level - ## root (maybe;default (new-hierarchy []) + ## root (maybe.default (new-hierarchy []) ## (pop-tail vec-size init-level (get@ #root vec))) ## ## root (: (Hierarchy ($ +0)) - ## ## (maybe;default (new-hierarchy []) + ## ## (maybe.default (new-hierarchy []) ## ## (pop-tail vec-size init-level (get@ #root vec)))) ## ] ## (if (n/> branching-exponent level) - ## (case [(array;read +1 root) (array;read +0 root)] - ## [#;None (#;Some (#Hierarchy sub-node))] + ## (case [(array.read +1 root) (array.read +0 root)] + ## [#.None (#.Some (#Hierarchy sub-node))] ## (recur (level-down level) sub-node) - ## ## [#;None (#;Some (#Base _))] + ## ## [#.None (#.Some (#Base _))] ## ## (undefined) ## _ @@ -323,14 +323,14 @@ (let [init-level (get@ #level vec)] (loop [level init-level root (: (Hierarchy ($ +0)) - (maybe;default (new-hierarchy []) + (maybe.default (new-hierarchy []) (pop-tail vec-size init-level (get@ #root vec))))] (if (n/> branching-exponent level) - (case [(array;read +1 root) (array;read +0 root)] - [#;None (#;Some (#Hierarchy sub-node))] + (case [(array.read +1 root) (array.read +0 root)] + [#.None (#.Some (#Hierarchy sub-node))] (recur (level-down level) sub-node) - [#;None (#;Some (#Base _))] + [#.None (#.Some (#Base _))] (undefined) _ @@ -359,15 +359,15 @@ (def: #export (member? a/Eq vec val) (All [a] (-> (Eq a) (Sequence a) a Bool)) - (list;member? a/Eq (to-list vec) val)) + (list.member? a/Eq (to-list vec) val)) (def: #export empty? (All [a] (-> (Sequence a) Bool)) (|>> (get@ #size) (n/= +0))) ## [Syntax] -(syntax: #export (sequence [elems (p;some s;any)]) - {#;doc (doc "Sequence literals." +(syntax: #export (sequence [elems (p.some s.any)]) + {#.doc (doc "Sequence literals." (sequence 10 20 30 40))} (wrap (list (` (from-list (list (~@ elems))))))) @@ -376,10 +376,10 @@ (def: (= v1 v2) (case [v1 v2] [(#Base b1) (#Base b2)] - (:: (array;Eq<Array> Eq<a>) = b1 b2) + (:: (array.Eq<Array> Eq<a>) = b1 b2) [(#Hierarchy h1) (#Hierarchy h2)] - (:: (array;Eq<Array> (Eq<Node> Eq<a>)) = h1 h2) + (:: (array.Eq<Array> (Eq<Node> Eq<a>)) = h1 h2) _ false))) diff --git a/stdlib/source/lux/data/coll/set.lux b/stdlib/source/lux/data/coll/set.lux index b8f860353..a08b16d39 100644 --- a/stdlib/source/lux/data/coll/set.lux +++ b/stdlib/source/lux/data/coll/set.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] [hash #*]) @@ -7,28 +7,28 @@ ## [Types] (type: #export (Set a) - (dict;Dict a a)) + (dict.Dict a a)) ## [Values] (def: #export (new Hash<a>) (All [a] (-> (Hash a) (Set a))) - (dict;new Hash<a>)) + (dict.new Hash<a>)) (def: #export (add elem set) (All [a] (-> a (Set a) (Set a))) - (dict;put elem elem set)) + (dict.put elem elem set)) (def: #export (remove elem set) (All [a] (-> a (Set a) (Set a))) - (dict;remove elem set)) + (dict.remove elem set)) (def: #export (member? set elem) (All [a] (-> (Set a) a Bool)) - (dict;contains? elem set)) + (dict.contains? elem set)) (def: #export to-list (All [a] (-> (Set a) (List a))) - dict;keys) + dict.keys) (def: #export (from-list Hash<a> xs) (All [a] (-> (Hash a) (List a) (Set a))) @@ -36,7 +36,7 @@ (def: #export (union xs yx) (All [a] (-> (Set a) (Set a) (Set a))) - (dict;merge xs yx)) + (dict.merge xs yx)) (def: #export (difference sub base) (All [a] (-> (Set a) (Set a) (Set a))) @@ -44,19 +44,19 @@ (def: #export (intersection filter base) (All [a] (-> (Set a) (Set a) (Set a))) - (dict;select (dict;keys filter) base)) + (dict.select (dict.keys filter) base)) (def: #export (size set) (All [a] (-> (Set a) Nat)) - (dict;size set)) + (dict.size set)) (def: #export (empty? set) (All [a] (-> (Set a) Bool)) - (n/= +0 (dict;size set))) + (n/= +0 (dict.size set))) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bool)) - (list;every? (member? super) (to-list sub))) + (list.every? (member? super) (to-list sub))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bool)) @@ -65,7 +65,7 @@ ## [Structures] (struct: #export Eq<Set> (All [a] (Eq (Set a))) (def: (= (^@ test [Hash<a> _]) subject) - (:: (list;Eq<List> (get@ #hash;eq Hash<a>)) = (to-list test) (to-list subject)))) + (:: (list.Eq<List> (get@ #hash.eq Hash<a>)) = (to-list test) (to-list subject)))) (struct: #export Hash<Set> (All [a] (Hash (Set a))) (def: eq Eq<Set>) diff --git a/stdlib/source/lux/data/coll/stack.lux b/stdlib/source/lux/data/coll/stack.lux index 6dbb8b817..8f93bdb69 100644 --- a/stdlib/source/lux/data/coll/stack.lux +++ b/stdlib/source/lux/data/coll/stack.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data (coll [list])))) @@ -13,30 +13,30 @@ (def: #export (size stack) (All [a] (-> (Stack a) Nat)) - (list;size stack)) + (list.size stack)) (def: #export (empty? stack) (All [a] (-> (Stack a) Bool)) - (list;empty? stack)) + (list.empty? stack)) (def: #export (peek stack) (All [a] (-> (Stack a) (Maybe a))) (case stack - #;Nil - #;None + #.Nil + #.None - (#;Cons value _) - (#;Some value))) + (#.Cons value _) + (#.Some value))) (def: #export (pop stack) (All [a] (-> (Stack a) (Stack a))) (case stack - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons _ stack') + (#.Cons _ stack') stack')) (def: #export (push value stack) (All [a] (-> a (Stack a) (Stack a))) - (#;Cons value stack)) + (#.Cons value stack)) diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux index 0f1297e8f..0cfa549bb 100644 --- a/stdlib/source/lux/data/coll/stream.lux +++ b/stdlib/source/lux/data/coll/stream.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control functor monad @@ -12,7 +12,7 @@ ## [Types] (type: #export (Stream a) - {#;doc "An infinite stream of values."} + {#.doc "An infinite stream of values."} (Cont [a (Stream a)])) ## [Utils] @@ -20,36 +20,36 @@ (All [a] (-> a (List a) a (List a) (Stream a))) (case xs - #;Nil (pending [x (cycle' init full init full)]) - (#;Cons x' xs') (pending [x (cycle' x' xs' init full)]))) + #.Nil (pending [x (cycle' init full init full)]) + (#.Cons x' xs') (pending [x (cycle' x' xs' init full)]))) ## [Functions] (def: #export (iterate f x) - {#;doc "Create a stream by applying a function to a value, and to its result, on and on..."} + {#.doc "Create a stream by applying a function to a value, and to its result, on and on..."} (All [a] (-> (-> a a) a (Stream a))) (pending [x (iterate f (f x))])) (def: #export (repeat x) - {#;doc "Repeat a value forever."} + {#.doc "Repeat a value forever."} (All [a] (-> a (Stream a))) (pending [x (repeat x)])) (def: #export (cycle xs) - {#;doc "Go over the elements of a list forever. + {#.doc "Go over the elements of a list forever. The list should not be empty."} (All [a] (-> (List a) (Maybe (Stream a)))) (case xs - #;Nil #;None - (#;Cons x xs') (#;Some (cycle' x xs' x xs')))) + #.Nil #.None + (#.Cons x xs') (#.Some (cycle' x xs' x xs')))) (do-template [<name> <return> <part>] [(def: #export (<name> s) (All [a] (-> (Stream a) <return>)) - (let [[h t] (cont;run s)] + (let [[h t] (cont.run s)] <part>))] [head a h] @@ -57,7 +57,7 @@ (def: #export (nth idx s) (All [a] (-> Nat (Stream a) a)) - (let [[h t] (cont;run s)] + (let [[h t] (cont.run s)] (if (n/> +0 idx) (nth (n/dec idx) t) h))) @@ -66,7 +66,7 @@ [(def: #export (<taker> pred xs) (All [a] (-> <pred-type> (Stream a) (List a))) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if <pred-test> (list& x (<taker> <pred-step> xs')) (list)))) @@ -74,7 +74,7 @@ (def: #export (<dropper> pred xs) (All [a] (-> <pred-type> (Stream a) (Stream a))) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if <pred-test> (<dropper> <pred-step> xs') xs))) @@ -82,10 +82,10 @@ (def: #export (<splitter> pred xs) (All [a] (-> <pred-type> (Stream a) [(List a) (Stream a)])) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if <pred-test> (let [[tail next] (<splitter> <pred-step> xs')] - [(#;Cons [x tail]) next]) + [(#.Cons [x tail]) next]) [(list) xs])))] [take-while drop-while split-while (-> a Bool) (pred x) pred] @@ -93,7 +93,7 @@ ) (def: #export (unfold step init) - {#;doc "A stateful way of infinitely calculating the values of a stream."} + {#.doc "A stateful way of infinitely calculating the values of a stream."} (All [a b] (-> (-> a [a b]) a (Stream b))) (let [[next x] (step init)] @@ -101,13 +101,13 @@ (def: #export (filter p xs) (All [a] (-> (-> a Bool) (Stream a) (Stream a))) - (let [[x xs'] (cont;run xs)] + (let [[x xs'] (cont.run xs)] (if (p x) (pending [x (filter p xs')]) (filter p xs')))) (def: #export (partition p xs) - {#;doc "Split a stream in two based on a predicate. + {#.doc "Split a stream in two based on a predicate. The left side contains all entries for which the predicate is true. @@ -118,26 +118,26 @@ ## [Structures] (struct: #export _ (Functor Stream) (def: (map f fa) - (let [[h t] (cont;run fa)] + (let [[h t] (cont.run fa)] (pending [(f h) (map f t)])))) (struct: #export _ (CoMonad Stream) (def: functor Functor<Stream>) (def: unwrap head) (def: (split wa) - (let [[head tail] (cont;run wa)] + (let [[head tail] (cont.run wa)] (pending [wa (split tail)])))) ## [Pattern-matching] -(syntax: #export (^stream& [patterns (s;form (p;many s;any))] body [branches (p;some s;any)]) - {#;doc (doc "Allows destructuring of streams in pattern-matching expressions." +(syntax: #export (^stream& [patterns (s.form (p.many s.any))] body [branches (p.some s.any)]) + {#.doc (doc "Allows destructuring of streams in pattern-matching expressions." "Caveat emptor: Only use it for destructuring, and not for testing values within the streams." (let [(^stream& x y z _tail) (some-stream-func 1 2 3)] (func x y z)))} (with-gensyms [g!s] (let [body+ (` (let [(~@ (List/join (List/map (function [pattern] (list (` [(~ pattern) (~ g!s)]) - (` (cont;run (~ g!s))))) + (` (cont.run (~ g!s))))) patterns)))] (~ body)))] (wrap (list& g!s body+ branches))))) diff --git a/stdlib/source/lux/data/coll/tree/finger.lux b/stdlib/source/lux/data/coll/tree/finger.lux index 355c89b55..3cf904c3f 100644 --- a/stdlib/source/lux/data/coll/tree/finger.lux +++ b/stdlib/source/lux/data/coll/tree/finger.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["m" monoid]) (data text/format))) @@ -8,7 +8,7 @@ (#Branch m (Node m a) (Node m a))) (type: #export (Fingers m a) - {#monoid (m;Monoid m) + {#monoid (m.Monoid m) #tree (Node m a)}) (def: #export (tag fingers) @@ -36,17 +36,17 @@ (def: #export (search pred fingers) (All [m a] (-> (-> m Bool) (Fingers m a) (Maybe a))) - (let [tag/compose (get@ [#monoid #m;compose] fingers)] + (let [tag/compose (get@ [#monoid #m.compose] fingers)] (if (pred (tag fingers)) - (loop [_tag (get@ [#monoid #m;identity] fingers) + (loop [_tag (get@ [#monoid #m.identity] fingers) _node (get@ #tree fingers)] (case _node (#Leaf _ value) - (#;Some value) + (#.Some value) (#Branch _ left right) (let [shifted-tag (tag/compose _tag (tag (set@ #tree left fingers)))] (if (pred shifted-tag) (recur _tag left) (recur shifted-tag right))))) - #;None))) + #.None))) diff --git a/stdlib/source/lux/data/coll/tree/parser.lux b/stdlib/source/lux/data/coll/tree/parser.lux index ac6dc2a85..2489e991b 100644 --- a/stdlib/source/lux/data/coll/tree/parser.lux +++ b/stdlib/source/lux/data/coll/tree/parser.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["p" parser] ["ex" exception #+ exception:]) @@ -7,25 +7,25 @@ ["Z" zipper])) (type: #export (Parser t a) - (p;Parser (Z;Zipper t) a)) + (p.Parser (Z.Zipper t) a)) (def: #export (run-zipper zipper parser) - (All [t a] (-> (Z;Zipper t) (Parser t a) (E;Error a))) - (case (p;run zipper parser) - (#E;Success [zipper output]) - (#E;Success output) + (All [t a] (-> (Z.Zipper t) (Parser t a) (E.Error a))) + (case (p.run zipper parser) + (#E.Success [zipper output]) + (#E.Success output) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) (def: #export (run tree parser) - (All [t a] (-> (T;Tree t) (Parser t a) (E;Error a))) - (run-zipper (Z;zip tree) parser)) + (All [t a] (-> (T.Tree t) (Parser t a) (E.Error a))) + (run-zipper (Z.zip tree) parser)) (def: #export value (All [t] (Parser t t)) (function [zipper] - (#E;Success [zipper (Z;value zipper)]))) + (#E.Success [zipper (Z.value zipper)]))) (exception: #export Cannot-Move-Further) @@ -35,16 +35,16 @@ (function [zipper] (let [next (<direction> zipper)] (if (is zipper next) - (ex;throw Cannot-Move-Further "") - (#E;Success [next []])))))] - - [up Z;up] - [down Z;down] - [left Z;left] - [right Z;right] - [root Z;root] - [rightmost Z;rightmost] - [leftmost Z;leftmost] - [next Z;next] - [prev Z;prev] + (ex.throw Cannot-Move-Further "") + (#E.Success [next []])))))] + + [up Z.up] + [down Z.down] + [left Z.left] + [right Z.right] + [root Z.root] + [rightmost Z.rightmost] + [leftmost Z.leftmost] + [next Z.next] + [prev Z.prev] ) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index e86dac944..077f68191 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control functor [monad #+ do Monad] @@ -18,7 +18,7 @@ ## [Values] (def: #export (flatten tree) (All [a] (-> (Tree a) (List a))) - (#;Cons (get@ #value tree) + (#.Cons (get@ #value tree) (L/join (L/map flatten (get@ #children tree))))) (def: #export (leaf value) @@ -37,15 +37,15 @@ (def: tree^ (Syntax Tree-Code) - (|> (|>> p;some s;record (p;seq s;any)) - p;rec - p;some - s;record - (p;seq s;any) - s;tuple)) + (|> (|>> p.some s.record (p.seq s.any)) + p.rec + p.some + s.record + (p.seq s.any) + s.tuple)) (syntax: #export (tree [root tree^]) - {#;doc (doc "Tree literals." + {#.doc (doc "Tree literals." (tree Int [10 {20 {} 30 {} 40 {}}]))} @@ -57,7 +57,7 @@ (struct: #export (Eq<Tree> Eq<a>) (All [a] (-> (Eq a) (Eq (Tree a)))) (def: (= tx ty) (and (:: Eq<a> = (get@ #value tx) (get@ #value ty)) - (:: (list;Eq<List> (Eq<Tree> Eq<a>)) = (get@ #children tx) (get@ #children ty))))) + (:: (list.Eq<List> (Eq<Tree> Eq<a>)) = (get@ #children tx) (get@ #children ty))))) (struct: #export _ (Functor Tree) (def: (map f fa) diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index e355f7238..421c10fe9 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control functor comonad) @@ -14,7 +14,7 @@ ## [Types] (type: #export (Zipper a) - {#;doc "Tree zippers, for easy navigation and editing over trees."} + {#.doc "Tree zippers, for easy navigation and editing over trees."} {#parent (Maybe (Zipper a)) #lefts (Stack (Tree a)) #rights (Stack (Tree a)) @@ -23,9 +23,9 @@ ## [Values] (def: #export (zip tree) (All [a] (-> (Tree a) (Zipper a))) - {#parent #;None - #lefts stack;empty - #rights stack;empty + {#parent #.None + #lefts stack.empty + #rights stack.empty #node tree}) (def: #export (unzip zipper) @@ -34,15 +34,15 @@ (def: #export (value zipper) (All [a] (-> (Zipper a) a)) - (|> zipper (get@ [#node #rose;value]))) + (|> zipper (get@ [#node #rose.value]))) (def: #export (children zipper) (All [a] (-> (Zipper a) (List (Tree a)))) - (|> zipper (get@ [#node #rose;children]))) + (|> zipper (get@ [#node #rose.children]))) (def: #export (branch? zipper) (All [a] (-> (Zipper a) Bool)) - (|> zipper children list;empty? not)) + (|> zipper children list.empty? not)) (def: #export (leaf? zipper) (All [a] (-> (Zipper a) Bool)) @@ -50,13 +50,13 @@ (def: #export (end? zipper) (All [a] (-> (Zipper a) Bool)) - (and (list;empty? (get@ #rights zipper)) - (list;empty? (children zipper)))) + (and (list.empty? (get@ #rights zipper)) + (list.empty? (children zipper)))) (def: #export (root? zipper) (All [a] (-> (Zipper a) Bool)) (case (get@ #parent zipper) - #;None + #.None true _ @@ -65,27 +65,27 @@ (def: #export (down zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (children zipper) - #;Nil + #.Nil zipper - (#;Cons chead ctail) - {#parent (#;Some zipper) - #lefts stack;empty + (#.Cons chead ctail) + {#parent (#.Some zipper) + #lefts stack.empty #rights ctail #node chead})) (def: #export (up zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (get@ #parent zipper) - #;None + #.None zipper - (#;Some parent) + (#.Some parent) (|> parent (update@ #node (: (-> (Tree ($ +0)) (Tree ($ +0))) (function [node] - (set@ #rose;children (L/compose (list;reverse (get@ #lefts zipper)) - (#;Cons (get@ #node zipper) + (set@ #rose.children (L/compose (list.reverse (get@ #lefts zipper)) + (#.Cons (get@ #node zipper) (get@ #rights zipper))) node))))))) @@ -93,20 +93,20 @@ (All [a] (-> (Zipper a) (Zipper a))) (loop [zipper zipper] (case (get@ #parent zipper) - #;None zipper - (#;Some _) (recur (up zipper))))) + #.None zipper + (#.Some _) (recur (up zipper))))) (do-template [<one-name> <all-name> <side> <op-side>] [(def: #export (<one-name> zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (get@ <side> zipper) - #;Nil + #.Nil zipper - (#;Cons next side') + (#.Cons next side') (|> zipper (update@ <op-side> (function [op-side] - (#;Cons (get@ #node zipper) op-side))) + (#.Cons (get@ #node zipper) op-side))) (set@ <side> side') (set@ #node next)))) @@ -122,7 +122,7 @@ [(def: #export (<name> zipper) (All [a] (-> (Zipper a) (Zipper a))) (case (get@ <h-side> zipper) - #;Nil + #.Nil (<v-op> zipper) _ @@ -134,44 +134,44 @@ (def: #export (set value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (set@ [#node #rose;value] value zipper)) + (set@ [#node #rose.value] value zipper)) (def: #export (update f zipper) (All [a] (-> (-> a a) (Zipper a) (Zipper a))) - (update@ [#node #rose;value] f zipper)) + (update@ [#node #rose.value] f zipper)) (def: #export (prepend-child value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (update@ [#node #rose;children] + (update@ [#node #rose.children] (function [children] (list& (: (Tree ($ +0)) - (rose;tree [value {}])) + (rose.tree [value {}])) children)) zipper)) (def: #export (append-child value zipper) (All [a] (-> a (Zipper a) (Zipper a))) - (update@ [#node #rose;children] + (update@ [#node #rose.children] (function [children] (L/compose children (list (: (Tree ($ +0)) - (rose;tree [value {}]))))) + (rose.tree [value {}]))))) zipper)) (def: #export (remove zipper) (All [a] (-> (Zipper a) (Maybe (Zipper a)))) (case (get@ #lefts zipper) - #;Nil + #.Nil (case (get@ #parent zipper) - #;None - #;None + #.None + #.None - (#;Some next) - (#;Some (|> next - (update@ [#node #rose;children] (|>> list;tail (maybe;default (list))))))) + (#.Some next) + (#.Some (|> next + (update@ [#node #rose.children] (|>> list.tail (maybe.default (list))))))) - (#;Cons next side) - (#;Some (|> zipper + (#.Cons next side) + (#.Some (|> zipper (set@ #lefts side) (set@ #node next))))) @@ -179,14 +179,14 @@ [(def: #export (<name> value zipper) (All [a] (-> a (Zipper a) (Maybe (Zipper a)))) (case (get@ #parent zipper) - #;None - #;None + #.None + #.None _ - (#;Some (|> zipper + (#.Some (|> zipper (update@ <side> (function [side] - (#;Cons (: (Tree ($ +0)) - (rose;tree [value {}])) + (#.Cons (: (Tree ($ +0)) + (rose.tree [value {}])) side)))))))] [insert-left #lefts] @@ -203,13 +203,13 @@ ## (struct: #export _ (CoMonad Zipper) ## (def: functor Functor<Zipper>) -## (def: unwrap (get@ [#node #rose;value])) +## (def: unwrap (get@ [#node #rose.value])) ## (def: (split wa) ## (let [tree-splitter (function tree-splitter [tree] -## {#rose;value (zip tree) -## #rose;children (L/map tree-splitter -## (get@ #rose;children tree))})] +## {#rose.value (zip tree) +## #rose.children (L/map tree-splitter +## (get@ #rose.children tree))})] ## {#parent (|> wa (get@ #parent) (M/map split)) ## #lefts (|> wa (get@ #lefts) (L/map tree-splitter)) ## #rights (|> wa (get@ #rights) (L/map tree-splitter)) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 3340629c3..9e5c828e4 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq]) (data (coll [list "L/" Functor<List>])) @@ -36,7 +36,7 @@ (-> Color [Nat Nat Nat]) (|>> @repr)) - (struct: #export _ (eq;Eq Color) + (struct: #export _ (eq.Eq Color) (def: (= reference sample) (let [[rr rg rb] (@repr reference) [sr sg sb] (@repr sample)] @@ -148,7 +148,7 @@ (def: #export (from-hsb [hue saturation brightness]) (-> [Frac Frac Frac] Color) (let [hue (|> hue (f/* 6.0)) - i (math;floor hue) + i (math.floor hue) f (|> hue (f/- i)) p (|> 1.0 (f/- saturation) (f/* brightness)) q (|> 1.0 (f/- (f/* f saturation)) (f/* brightness)) @@ -230,7 +230,7 @@ (-> Color Color) (let [[red green blue] (unpack color) adjust (function [value] (|> top (n/- value)))] - (;;color [(adjust red) + (..color [(adjust red) (adjust green) (adjust blue)]))) @@ -289,7 +289,7 @@ (from-hsl [(|> idx nat-to-frac (f/* slice) (f/+ hue) normalize) saturation luminance])) - (list;n/range +0 (n/dec results)))))) + (list.n/range +0 (n/dec results)))))) (def: #export (monochromatic results color) (-> Nat Color (List Color)) @@ -297,7 +297,7 @@ (list) (let [[hue saturation brightness] (to-hsb color) slice (|> 1.0 (f// (nat-to-frac results)))] - (|> (list;n/range +0 (n/dec results)) + (|> (list.n/range +0 (n/dec results)) (L/map (|>> nat-to-frac (f/* slice) (f/+ brightness) diff --git a/stdlib/source/lux/data/env.lux b/stdlib/source/lux/data/env.lux index b6f96be68..880bfa621 100644 --- a/stdlib/source/lux/data/env.lux +++ b/stdlib/source/lux/data/env.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] comonad))) @@ -7,7 +7,7 @@ {#env e #value a}) -(struct: #export Functor<Env> (All [e] (F;Functor (Env e))) +(struct: #export Functor<Env> (All [e] (F.Functor (Env e))) (def: (map f fa) (update@ #value f fa))) diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux index e433d7454..773724321 100644 --- a/stdlib/source/lux/data/error.lux +++ b/stdlib/source/lux/data/error.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] ["A" applicative] @@ -10,13 +10,13 @@ (#Success a)) ## [Structures] -(struct: #export _ (F;Functor Error) +(struct: #export _ (F.Functor Error) (def: (map f ma) (case ma (#Error msg) (#Error msg) (#Success datum) (#Success (f datum))))) -(struct: #export _ (A;Applicative Error) +(struct: #export _ (A.Applicative Error) (def: functor Functor<Error>) (def: (wrap a) @@ -46,7 +46,7 @@ (struct: #export (ErrorT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Error a)))))) - (def: applicative (A;compose (get@ #M;applicative Monad<M>) Applicative<Error>)) + (def: applicative (A.compose (get@ #M.applicative Monad<M>) Applicative<Error>)) (def: (join MeMea) (do Monad<M> [eMea MeMea] @@ -59,7 +59,7 @@ (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (Error a))))) - (M;lift Monad<M> (:: Monad<Error> wrap))) + (M.lift Monad<M> (:: Monad<Error> wrap))) (def: #export (succeed value) (All [a] (-> a (Error a))) @@ -79,7 +79,7 @@ (error! message))) (macro: #export (default tokens compiler) - {#;doc (doc "Allows you to provide a default value that will be used" + {#.doc (doc "Allows you to provide a default value that will be used" "if a (Error x) value turns out to be #Error." (is 10 (default 20 (#Success 10))) @@ -88,10 +88,10 @@ (case tokens (^ (list else error)) (#Success [compiler (list (` (case (~ error) - (#;;Success (~' g!temp)) + (#..Success (~' g!temp)) (~' g!temp) - (#;;Error (~ [dummy-cursor (#;Symbol ["" ""])])) + (#..Error (~ [dummy-cursor (#.Symbol ["" ""])])) (~ else))))]) _ diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux index 5f0d29b11..a52de9af8 100644 --- a/stdlib/source/lux/data/format/context.lux +++ b/stdlib/source/lux/data/format/context.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["p" parser] ["ex" exception #+ exception:] @@ -9,26 +9,26 @@ (exception: #export Unknown-Property) (type: #export Context - (d;Dict Text Text)) + (d.Dict Text Text)) (type: #export (Property a) - (p;Parser Context a)) + (p.Parser Context a)) (def: #export (property name) (-> Text (Property Text)) (function [context] - (case (d;get name context) - (#;Some value) - (ex;return [context value]) + (case (d.get name context) + (#.Some value) + (ex.return [context value]) - #;None - (ex;throw Unknown-Property name)))) + #.None + (ex.throw Unknown-Property name)))) (def: #export (run context property) - (All [a] (-> Context (Property a) (E;Error a))) + (All [a] (-> Context (Property a) (E.Error a))) (case (property context) - (#E;Success [_ output]) - (#E;Success output) + (#E.Success [_ output]) + (#E.Success output) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 2b0a1a03b..4f148110f 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [color #+ Color] [number] @@ -13,7 +13,7 @@ (type: #export Value Text) (type: #export Style - {#;doc "The style associated with a CSS selector."} + {#.doc "The style associated with a CSS selector."} (List [Property Value])) (type: #export Rule [Selector Style]) @@ -26,20 +26,20 @@ (-> Style Text) (|> style (L/map (function [[key val]] (format key ": " val))) - (text;join-with "; "))) + (text.join-with "; "))) (def: #export (css sheet) (-> Sheet CSS) (|> sheet (L/map (function [[selector style]] - (if (list;empty? style) + (if (list.empty? style) "" (format selector "{" (inline style) "}")))) - (text;join-with "\n"))) + (text.join-with "\n"))) (def: #export (rgb color) (-> Color Value) - (let [[red green blue] (color;unpack color)] + (let [[red green blue] (color.unpack color)] (format "rgb(" (|> red nat-to-int %i) "," (|> green nat-to-int %i) "," (|> blue nat-to-int %i) @@ -47,11 +47,11 @@ (def: #export (rgba color alpha) (-> Color Deg Value) - (let [[red green blue] (color;unpack color)] + (let [[red green blue] (color.unpack color)] (format "rgba(" (|> red nat-to-int %i) "," (|> green nat-to-int %i) "," (|> blue nat-to-int %i) - "," (if (d/= (:: number;Interval<Deg> top) alpha) + "," (if (d/= (:: number.Interval<Deg> top) alpha) "1.0" (format "0" (%d alpha))) ")"))) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index e33e7d4ee..0c6b1bf0e 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -1,25 +1,25 @@ -(;module: +(.module: [lux #- comment] (lux (data [text] text/format (coll [list "L/" Functor<List>])))) (type: #export Attributes - {#;doc "Attributes for an HTML tag."} + {#.doc "Attributes for an HTML tag."} (List [Text Text])) (type: #export HTML Text) (def: #export (text value) - {#;doc "Properly formats text to ensure no injection can happen on the HTML."} + {#.doc "Properly formats text to ensure no injection can happen on the HTML."} (-> Text HTML) (|> value - (text;replace-all "&" "&") - (text;replace-all "<" "<") - (text;replace-all ">" ">") - (text;replace-all "\"" """) - (text;replace-all "'" "'") - (text;replace-all "/" "/"))) + (text.replace-all "&" "&") + (text.replace-all "<" "<") + (text.replace-all ">" ">") + (text.replace-all "\"" """) + (text.replace-all "'" "'") + (text.replace-all "/" "/"))) (def: #export (comment content) (-> Text HTML) @@ -28,13 +28,13 @@ (def: attrs-to-text (-> Attributes Text) (|>> (L/map (function [[key val]] (format key "=" "\"" (text val) "\""))) - (text;join-with " "))) + (text.join-with " "))) (def: #export (tag name attrs children) - {#;doc "Generates the HTML for a tag."} + {#.doc "Generates the HTML for a tag."} (-> Text Attributes (List HTML) HTML) (format "<" name " " (attrs-to-text attrs) ">" - (text;join-with " " children) + (text.join-with " " children) "</" name ">")) (do-template [<name> <doc-type>] @@ -44,7 +44,7 @@ document))] [html-5 "<!DOCTYPE html>"] - [html-4.01 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"] - [xhtml-1.0 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"] - [xhtml-1.1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"] + [html-4_01 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"] + [xhtml-1_0 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"] + [xhtml-1_1 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"] ) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index b007dba42..37d6f954f 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for reading and writing values in the JSON format. +(.module: {#.doc "Functionality for reading and writing values in the JSON format. For more information, please see: http://www.json.org/"} [lux #- Array] @@ -49,11 +49,11 @@ ) (type: #export (Reader a) - {#;doc "JSON reader."} - (p;Parser (List JSON) a)) + {#.doc "JSON reader."} + (p.Parser (List JSON) a)) (syntax: #export (json token) - {#;doc (doc "A simple way to produce JSON literals." + {#.doc (doc "A simple way to produce JSON literals." (json true) (json 123.456) (json "Some text") @@ -62,86 +62,86 @@ (json {"this" "is" "an" "object"}))} (let [(^open) Monad<Meta> - wrapper (function [x] (` (;;json (~ x))))] + wrapper (function [x] (` (..json (~ x))))] (case token (^template [<ast-tag> <ctor> <json-tag>] [_ (<ast-tag> value)] (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))) - ([#;Bool code;bool #Boolean] - [#;Frac code;frac #Number] - [#;Text code;text #String]) + ([#.Bool code.bool #Boolean] + [#.Frac code.frac #Number] + [#.Text code.text #String]) - [_ (#;Tag ["" "null"])] + [_ (#.Tag ["" "null"])] (wrap (list (` (: JSON #Null)))) - [_ (#;Tuple members)] + [_ (#.Tuple members)] (wrap (list (` (: JSON (#Array (sequence (~@ (list/map wrapper members)))))))) - [_ (#;Record pairs)] + [_ (#.Record pairs)] (do Monad<Meta> - [pairs' (monad;map @ + [pairs' (monad.map @ (function [[slot value]] (case slot - [_ (#;Text key-name)] - (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) + [_ (#.Text key-name)] + (wrap (` [(~ (code.text key-name)) (~ (wrapper value))])) _ - (macro;fail "Wrong syntax for JSON object."))) + (macro.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#Object (dict;from-list text;Hash<Text> (list (~@ pairs'))))))))) + (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~@ pairs'))))))))) _ (wrap (list token)) ))) (def: #export (get-fields json) - {#;doc "Get all the fields in a JSON object."} - (-> JSON (e;Error (List String))) + {#.doc "Get all the fields in a JSON object."} + (-> JSON (e.Error (List String))) (case json (#Object obj) - (#e;Success (dict;keys obj)) + (#e.Success (dict.keys obj)) _ - (#e;Error ($_ text/compose "Cannot get the fields of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get the fields of a non-object.")))) (def: #export (get key json) - {#;doc "A JSON object field getter."} - (-> String JSON (e;Error JSON)) + {#.doc "A JSON object field getter."} + (-> String JSON (e.Error JSON)) (case json (#Object obj) - (case (dict;get key obj) - (#;Some value) - (#e;Success value) + (case (dict.get key obj) + (#.Some value) + (#e.Success value) - #;None - (#e;Error ($_ text/compose "Missing field \"" key "\" on object."))) + #.None + (#e.Error ($_ text/compose "Missing field \"" key "\" on object."))) _ - (#e;Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) (def: #export (set key value json) - {#;doc "A JSON object field setter."} - (-> String JSON JSON (e;Error JSON)) + {#.doc "A JSON object field setter."} + (-> String JSON JSON (e.Error JSON)) (case json (#Object obj) - (#e;Success (#Object (dict;put key value obj))) + (#e.Success (#Object (dict.put key value obj))) _ - (#e;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) + (#e.Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#;doc (code;text ($_ text/compose "A JSON object field getter for " <desc> "."))} - (-> Text JSON (e;Error <type>)) + {#.doc (code.text ($_ text/compose "A JSON object field getter for " <desc> "."))} + (-> Text JSON (e.Error <type>)) (case (get key json) - (#e;Success (<tag> value)) - (#e;Success value) + (#e.Success (<tag> value)) + (#e.Success value) - (#e;Success _) - (#e;Error ($_ text/compose "Wrong value type at key: " key)) + (#e.Success _) + (#e.Error ($_ text/compose "Wrong value type at key: " key)) - (#e;Error error) - (#e;Error error)))] + (#e.Error error) + (#e.Error error)))] [get-boolean #Boolean Boolean "booleans"] [get-number #Number Number "numbers"] @@ -159,31 +159,31 @@ (^template [<tag> <struct>] [(<tag> x') (<tag> y')] (:: <struct> = x' y')) - ([#Boolean bool;Eq<Bool>] - [#Number number;Eq<Frac>] - [#String text;Eq<Text>]) + ([#Boolean bool.Eq<Bool>] + [#Number number.Eq<Frac>] + [#String text.Eq<Text>]) [(#Array xs) (#Array ys)] - (and (n/= (sequence;size xs) (sequence;size ys)) + (and (n/= (sequence.size xs) (sequence.size ys)) (list/fold (function [idx prev] (and prev - (maybe;default false - (do maybe;Monad<Maybe> - [x' (sequence;nth idx xs) - y' (sequence;nth idx ys)] + (maybe.default false + (do maybe.Monad<Maybe> + [x' (sequence.nth idx xs) + y' (sequence.nth idx ys)] (wrap (= x' y')))))) true - (list;indices (sequence;size xs)))) + (list.indices (sequence.size xs)))) [(#Object xs) (#Object ys)] - (and (n/= (dict;size xs) (dict;size ys)) + (and (n/= (dict.size xs) (dict.size ys)) (list/fold (function [[xk xv] prev] (and prev - (case (dict;get xk ys) - #;None false - (#;Some yv) (= xv yv)))) + (case (dict.get xk ys) + #.None false + (#.Some yv) (= xv yv)))) true - (dict;entries xs))) + (dict.entries xs))) _ false))) @@ -195,40 +195,40 @@ (def: unconsumed-input-error Text "Unconsumed JSON.") (def: #export (run json parser) - (All [a] (-> JSON (Reader a) (e;Error a))) - (case (p;run (list json) parser) - (#e;Success [remainder output]) + (All [a] (-> JSON (Reader a) (e.Error a))) + (case (p.run (list json) parser) + (#e.Success [remainder output]) (case remainder - #;Nil - (#e;Success output) + #.Nil + (#e.Success output) _ - (#e;Error unconsumed-input-error)) + (#e.Error unconsumed-input-error)) - (#e;Error error) - (#e;Error error))) + (#e.Error error) + (#e.Error error))) (def: #export (fail error) (All [a] (-> Text (Reader a))) (function [inputs] - (#e;Error error))) + (#e.Error error))) (def: #export any - {#;doc "Just returns the JSON input without applying any logic."} + {#.doc "Just returns the JSON input without applying any logic."} (Reader JSON) (<| (function [inputs]) (case inputs - #;Nil - (#e;Error "Empty JSON stream.") + #.Nil + (#e.Error "Empty JSON stream.") - (#;Cons head tail) - (#e;Success [tail head])))) + (#.Cons head tail) + (#e.Success [tail head])))) (do-template [<name> <type> <tag> <desc>] [(def: #export <name> - {#;doc (code;text ($_ text/compose "Reads a JSON value as " <desc> "."))} + {#.doc (code.text ($_ text/compose "Reads a JSON value as " <desc> "."))} (Reader <type>) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -245,9 +245,9 @@ (do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] [(def: #export (<test> test) - {#;doc (code;text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} + {#.doc (code.text ($_ text/compose "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Reader Bool)) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -257,9 +257,9 @@ (fail ($_ text/compose "JSON value is not " <desc> "."))))) (def: #export (<check> test) - {#;doc (code;text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} + {#.doc (code.text ($_ text/compose "Ensures a JSON value is a " <desc> "."))} (-> <type> (Reader Unit)) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (<tag> value) @@ -271,30 +271,30 @@ _ (fail ($_ text/compose "JSON value is not a " <desc> ".")))))] - [boolean? boolean! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #Boolean "boolean" id] - [number? number! Frac number;Eq<Frac> (:: number;Codec<Text,Frac> encode) #Number "number" id] - [string? string! Text text;Eq<Text> text;encode #String "string" id] + [boolean? boolean! Bool bool.Eq<Bool> (:: bool.Codec<Text,Bool> encode) #Boolean "boolean" id] + [number? number! Frac number.Eq<Frac> (:: number.Codec<Text,Frac> encode) #Number "number" id] + [string? string! Text text.Eq<Text> text.encode #String "string" id] ) (def: #export (nullable parser) (All [a] (-> (Reader a) (Reader (Maybe a)))) - (p;alt null + (p.alt null parser)) (def: #export (array parser) - {#;doc "Parses a JSON array, assuming that every element can be parsed the same way."} + {#.doc "Parses a JSON array, assuming that every element can be parsed the same way."} (All [a] (-> (Reader a) (Reader a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Array values) - (case (p;run (sequence;to-list values) parser) - (#e;Error error) + (case (p.run (sequence.to-list values) parser) + (#e.Error error) (fail error) - (#e;Success [remainder output]) + (#e.Success [remainder output]) (case remainder - #;Nil + #.Nil (wrap output) _ @@ -304,46 +304,46 @@ (fail "JSON value is not an array.")))) (def: #export (object parser) - {#;doc "Parses a JSON object, assuming that every element can be parsed the same way."} + {#.doc "Parses a JSON object, assuming that every element can be parsed the same way."} (All [a] (-> (Reader a) (Reader (Dict Text a)))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Object object) - (case (do e;Monad<Error> + (case (do e.Monad<Error> [] - (|> (dict;entries object) - (monad;map @ (function [[key val]] + (|> (dict.entries object) + (monad.map @ (function [[key val]] (do @ [val (run val parser)] (wrap [key val])))) - (:: @ map (dict;from-list text;Hash<Text>)))) - (#e;Success table) + (:: @ map (dict.from-list text.Hash<Text>)))) + (#e.Success table) (wrap table) - (#e;Error error) + (#e.Error error) (fail error)) _ (fail "JSON value is not an array.")))) (def: #export (field field-name parser) - {#;doc "Parses a field inside a JSON object."} + {#.doc "Parses a field inside a JSON object."} (All [a] (-> Text (Reader a) (Reader a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [head any] (case head (#Object object) - (case (dict;get field-name object) - (#;Some value) + (case (dict.get field-name object) + (#.Some value) (case (run value parser) - (#e;Success output) + (#e.Success output) (function [tail] - (#e;Success [(#;Cons (#Object (dict;remove field-name object)) + (#e.Success [(#.Cons (#Object (dict.remove field-name object)) tail) output])) - (#e;Error error) + (#e.Error error) (fail error)) _ @@ -360,23 +360,23 @@ (do-template [<name> <type> <codec>] [(def: <name> (-> <type> Text) <codec>)] - [show-boolean Boolean (:: bool;Codec<Text,Bool> encode)] - [show-number Number (:: number;Codec<Text,Frac> encode)] - [show-string String text;encode]) + [show-boolean Boolean (:: bool.Codec<Text,Bool> encode)] + [show-number Number (:: number.Codec<Text,Frac> encode)] + [show-string String text.encode]) (def: (show-array show-json elems) (-> (-> JSON Text) (-> Array Text)) ($_ text/compose "[" - (|> elems (sequence/map show-json) sequence;to-list (text;join-with ",")) + (|> elems (sequence/map show-json) sequence.to-list (text.join-with ",")) "]")) (def: (show-object show-json object) (-> (-> JSON Text) (-> Object Text)) ($_ text/compose "{" (|> object - dict;entries + dict.entries (list/map (function [[key value]] ($_ text/compose (show-string key) ":" (show-json value)))) - (text;join-with ",")) + (text.join-with ",")) "}")) (def: (show-json json) @@ -394,24 +394,24 @@ )) (def: space~ - (l;Lexer Text) - (l;some l;space)) + (l.Lexer Text) + (l.some l.space)) (def: data-sep - (l;Lexer [Text Unit Text]) - ($_ p;seq space~ (l;this ",") space~)) + (l.Lexer [Text Unit Text]) + ($_ p.seq space~ (l.this ",") space~)) (def: null~ - (l;Lexer Null) - (do p;Monad<Parser> - [_ (l;this "null")] + (l.Lexer Null) + (do p.Monad<Parser> + [_ (l.this "null")] (wrap []))) (do-template [<name> <token> <value>] [(def: <name> - (l;Lexer Boolean) - (do p;Monad<Parser> - [_ (l;this <token>)] + (l.Lexer Boolean) + (do p.Monad<Parser> + [_ (l.this <token>)] (wrap <value>)))] [t~ "true" true] @@ -419,49 +419,49 @@ ) (def: boolean~ - (l;Lexer Boolean) - (p;either t~ f~)) + (l.Lexer Boolean) + (p.either t~ f~)) (def: number~ - (l;Lexer Number) - (do p;Monad<Parser> - [signed? (l;this? "-") - digits (l;many l;decimal) - decimals (p;default "0" + (l.Lexer Number) + (do p.Monad<Parser> + [signed? (l.this? "-") + digits (l.many l.decimal) + decimals (p.default "0" (do @ - [_ (l;this ".")] - (l;many l;decimal))) - exp (p;default "" + [_ (l.this ".")] + (l.many l.decimal))) + exp (p.default "" (do @ - [mark (l;one-of "eE") - signed?' (l;this? "-") - offset (l;many l;decimal)] + [mark (l.one-of "eE") + signed?' (l.this? "-") + offset (l.many l.decimal)] (wrap ($_ text/compose mark (if signed?' "-" "") offset))))] (case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp)) - (#e;Error message) - (p;fail message) + (#e.Error message) + (p.fail message) - (#e;Success value) + (#e.Success value) (wrap value)))) (def: escaped~ - (l;Lexer Text) - ($_ p;either - (p;after (l;this "\\t") (parser/wrap "\t")) - (p;after (l;this "\\b") (parser/wrap "\b")) - (p;after (l;this "\\n") (parser/wrap "\n")) - (p;after (l;this "\\r") (parser/wrap "\r")) - (p;after (l;this "\\f") (parser/wrap "\f")) - (p;after (l;this "\\\"") (parser/wrap "\"")) - (p;after (l;this "\\\\") (parser/wrap "\\")))) + (l.Lexer Text) + ($_ p.either + (p.after (l.this "\\t") (parser/wrap "\t")) + (p.after (l.this "\\b") (parser/wrap "\b")) + (p.after (l.this "\\n") (parser/wrap "\n")) + (p.after (l.this "\\r") (parser/wrap "\r")) + (p.after (l.this "\\f") (parser/wrap "\f")) + (p.after (l.this "\\\"") (parser/wrap "\"")) + (p.after (l.this "\\\\") (parser/wrap "\\")))) (def: string~ - (l;Lexer String) - (<| (l;enclosed ["\"" "\""]) + (l.Lexer String) + (<| (l.enclosed ["\"" "\""]) (loop [_ []]) - (do p;Monad<Parser> - [chars (l;some (l;none-of "\\\"")) - stop l;peek]) + (do p.Monad<Parser> + [chars (l.some (l.none-of "\\\"")) + stop l.peek]) (if (text/= "\\" stop) (do @ [escaped escaped~ @@ -470,34 +470,34 @@ (wrap chars)))) (def: (kv~ json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer [String JSON])) - (do p;Monad<Parser> + (-> (-> Unit (l.Lexer JSON)) (l.Lexer [String JSON])) + (do p.Monad<Parser> [key string~ _ space~ - _ (l;this ":") + _ (l.this ":") _ space~ value (json~ [])] (wrap [key value]))) (do-template [<name> <type> <open> <close> <elem-parser> <prep>] [(def: (<name> json~) - (-> (-> Unit (l;Lexer JSON)) (l;Lexer <type>)) - (do p;Monad<Parser> - [_ (l;this <open>) + (-> (-> Unit (l.Lexer JSON)) (l.Lexer <type>)) + (do p.Monad<Parser> + [_ (l.this <open>) _ space~ - elems (p;sep-by data-sep <elem-parser>) + elems (p.sep-by data-sep <elem-parser>) _ space~ - _ (l;this <close>)] + _ (l.this <close>)] (wrap (<prep> elems))))] - [array~ Array "[" "]" (json~ []) sequence;from-list] - [object~ Object "{" "}" (kv~ json~) (dict;from-list text;Hash<Text>)] + [array~ Array "[" "]" (json~ []) sequence.from-list] + [object~ Object "{" "}" (kv~ json~) (dict.from-list text.Hash<Text>)] ) (def: (json~' _) - (-> Unit (l;Lexer JSON)) - ($_ p;alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) + (-> Unit (l.Lexer JSON)) + ($_ p.alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) (struct: #export _ (Codec Text JSON) (def: encode show-json) - (def: decode (function [input] (l;run input (json~' []))))) + (def: decode (function [input] (l.run input (json~' []))))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 957628e94..2d7e0a6f4 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for reading, generating and processing values in the XML format."} +(.module: {#.doc "Functionality for reading, generating and processing values in the XML format."} lux (lux (control monad [eq #+ Eq] @@ -13,174 +13,173 @@ [maybe "m/" Monad<Maybe>] [ident "ident/" Eq<Ident> Codec<Text,Ident>] (coll [list "L/" Monad<List>] - ["d" dict])) - )) + ["d" dict])))) (type: #export Tag Ident) -(type: #export Attrs (d;Dict Ident Text)) +(type: #export Attrs (d.Dict Ident Text)) -(def: #export attrs Attrs (d;new ident;Hash<Ident>)) +(def: #export attrs Attrs (d.new ident.Hash<Ident>)) (type: #export #rec XML (#Text Text) (#Node Tag Attrs (List XML))) (def: xml-standard-escape-char^ - (l;Lexer Text) - ($_ p;either - (p;after (l;this "<") (p/wrap "<")) - (p;after (l;this ">") (p/wrap ">")) - (p;after (l;this "&") (p/wrap "&")) - (p;after (l;this "'") (p/wrap "'")) - (p;after (l;this """) (p/wrap "\"")))) + (l.Lexer Text) + ($_ p.either + (p.after (l.this "<") (p/wrap "<")) + (p.after (l.this ">") (p/wrap ">")) + (p.after (l.this "&") (p/wrap "&")) + (p.after (l.this "'") (p/wrap "'")) + (p.after (l.this """) (p/wrap "\"")))) (def: xml-unicode-escape-char^ - (l;Lexer Text) - (|> (do p;Monad<Parser> - [hex? (p;maybe (l;this "x")) + (l.Lexer Text) + (|> (do p.Monad<Parser> + [hex? (p.maybe (l.this "x")) code (case hex? - #;None - (p;codec number;Codec<Text,Int> (l;many l;decimal)) + #.None + (p.codec number.Codec<Text,Int> (l.many l.decimal)) - (#;Some _) - (p;codec number;Hex@Codec<Text,Int> (l;many l;hexadecimal)))] - (wrap (|> code int-to-nat text;from-code))) - (p;before (l;this ";")) - (p;after (l;this "&#")))) + (#.Some _) + (p.codec number.Hex@Codec<Text,Int> (l.many l.hexadecimal)))] + (wrap (|> code int-to-nat text.from-code))) + (p.before (l.this ";")) + (p.after (l.this "&#")))) (def: xml-escape-char^ - (l;Lexer Text) - (p;either xml-standard-escape-char^ + (l.Lexer Text) + (p.either xml-standard-escape-char^ xml-unicode-escape-char^)) (def: xml-char^ - (l;Lexer Text) - (p;either (l;none-of "<>&'\"") + (l.Lexer Text) + (p.either (l.none-of "<>&'\"") xml-escape-char^)) (def: xml-identifier - (l;Lexer Text) - (do p;Monad<Parser> - [head (p;either (l;one-of "_") - l;alpha) - tail (l;some (p;either (l;one-of "_.-") - l;alpha-num))] + (l.Lexer Text) + (do p.Monad<Parser> + [head (p.either (l.one-of "_") + l.alpha) + tail (l.some (p.either (l.one-of "_.-") + l.alpha-num))] (wrap ($_ text/compose head tail)))) (def: namespaced-symbol^ - (l;Lexer Ident) - (do p;Monad<Parser> + (l.Lexer Ident) + (do p.Monad<Parser> [first-part xml-identifier - ?second-part (<| p;maybe (p;after (l;this ":")) xml-identifier)] + ?second-part (<| p.maybe (p.after (l.this ":")) xml-identifier)] (case ?second-part - #;None + #.None (wrap ["" first-part]) - (#;Some second-part) + (#.Some second-part) (wrap [first-part second-part])))) (def: tag^ namespaced-symbol^) (def: attr-name^ namespaced-symbol^) (def: spaced^ - (All [a] (-> (l;Lexer a) (l;Lexer a))) - (let [white-space^ (p;some l;space)] - (|>> (p;before white-space^) - (p;after white-space^)))) + (All [a] (-> (l.Lexer a) (l.Lexer a))) + (let [white-space^ (p.some l.space)] + (|>> (p.before white-space^) + (p.after white-space^)))) (def: attr-value^ - (l;Lexer Text) - (let [value^ (l;some xml-char^)] - (p;either (l;enclosed ["\"" "\""] value^) - (l;enclosed ["'" "'"] value^)))) + (l.Lexer Text) + (let [value^ (l.some xml-char^)] + (p.either (l.enclosed ["\"" "\""] value^) + (l.enclosed ["'" "'"] value^)))) (def: attrs^ - (l;Lexer Attrs) - (<| (:: p;Monad<Parser> map (d;from-list ident;Hash<Ident>)) - p;some - (p;seq (spaced^ attr-name^)) - (p;after (l;this "=")) + (l.Lexer Attrs) + (<| (:: p.Monad<Parser> map (d.from-list ident.Hash<Ident>)) + p.some + (p.seq (spaced^ attr-name^)) + (p.after (l.this "=")) (spaced^ attr-value^))) (def: (close-tag^ expected) - (-> Tag (l;Lexer [])) - (do p;Monad<Parser> + (-> Tag (l.Lexer [])) + (do p.Monad<Parser> [actual (|> tag^ spaced^ - (p;after (l;this "/")) - (l;enclosed ["<" ">"]))] - (p;assert ($_ text/compose "Close tag does not match open tag.\n" + (p.after (l.this "/")) + (l.enclosed ["<" ">"]))] + (p.assert ($_ text/compose "Close tag does not match open tag.\n" "Expected: " (ident/encode expected) "\n" " Actual: " (ident/encode actual) "\n") (ident/= expected actual)))) (def: comment^ - (l;Lexer Text) - (|> (l;not (l;this "--")) - l;some - (l;enclosed ["<--" "-->"]) + (l.Lexer Text) + (|> (l.not (l.this "--")) + l.some + (l.enclosed ["<--" "-->"]) spaced^)) (def: xml-header^ - (l;Lexer Attrs) + (l.Lexer Attrs) (|> (spaced^ attrs^) - (p;before (l;this "?>")) - (p;after (l;this "<?xml")) + (p.before (l.this "?>")) + (p.after (l.this "<?xml")) spaced^)) (def: cdata^ - (l;Lexer Text) - (let [end (l;this "]]>")] - (|> (l;some (l;not end)) - (p;after end) - (p;after (l;this "<![CDATA[")) + (l.Lexer Text) + (let [end (l.this "]]>")] + (|> (l.some (l.not end)) + (p.after end) + (p.after (l.this "<![CDATA[")) spaced^))) (def: text^ - (l;Lexer XML) - (|> (p;either cdata^ - (l;many xml-char^)) + (l.Lexer XML) + (|> (p.either cdata^ + (l.many xml-char^)) (p/map (|>> #Text)))) (def: xml^ - (l;Lexer XML) - (|> (p;rec + (l.Lexer XML) + (|> (p.rec (function [node^] - (p;either text^ + (p.either text^ (spaced^ - (do p;Monad<Parser> - [_ (l;this "<") + (do p.Monad<Parser> + [_ (l.this "<") tag (spaced^ tag^) attrs (spaced^ attrs^) - #let [no-children^ (do p;Monad<Parser> - [_ (l;this "/>")] + #let [no-children^ (do p.Monad<Parser> + [_ (l.this "/>")] (wrap (#Node tag attrs (list)))) - with-children^ (do p;Monad<Parser> - [_ (l;this ">") - children (p;some node^) + with-children^ (do p.Monad<Parser> + [_ (l.this ">") + children (p.some node^) _ (close-tag^ tag)] (wrap (#Node tag attrs children)))]] - (p;either no-children^ + (p.either no-children^ with-children^)))))) ## This is put outside of the call to "rec" because comments ## cannot be located inside of XML nodes. ## This way, the comments can only be before or after the main document. - (p;before (p;some comment^)) - (p;after (p;some comment^)) - (p;after (p;maybe xml-header^)))) + (p.before (p.some comment^)) + (p.after (p.some comment^)) + (p.after (p.maybe xml-header^)))) (def: #export (read input) - (-> Text (E;Error XML)) - (l;run input xml^)) + (-> Text (E.Error XML)) + (l.run input xml^)) (def: (sanitize-value input) (-> Text Text) (|> input - (text;replace-all "&" "&") - (text;replace-all "<" "<") - (text;replace-all ">" ">") - (text;replace-all "'" "'") - (text;replace-all "\"" """))) + (text.replace-all "&" "&") + (text.replace-all "<" "<") + (text.replace-all ">" ">") + (text.replace-all "'" "'") + (text.replace-all "\"" """))) (def: (write-tag [namespace name]) (-> Tag Text) @@ -191,10 +190,10 @@ (def: (write-attrs attrs) (-> Attrs Text) (|> attrs - d;entries + d.entries (L/map (function [[key value]] ($_ text/compose (write-tag key) "=" "\""(sanitize-value value) "\""))) - (text;join-with " "))) + (text.join-with " "))) (def: xml-header Text @@ -210,15 +209,15 @@ (#Node xml-tag xml-attrs xml-children) (let [tag (write-tag xml-tag) - attrs (if (d;empty? xml-attrs) + attrs (if (d.empty? xml-attrs) "" ($_ text/compose " " (write-attrs xml-attrs)))] - (if (list;empty? xml-children) + (if (list.empty? xml-children) ($_ text/compose "<" tag attrs "/>") ($_ text/compose "<" tag attrs ">" (|> xml-children (L/map recur) - (text;join-with "")) + (text.join-with "")) "</" tag ">"))))))) (struct: #export _ (Codec Text XML) @@ -234,17 +233,17 @@ [(#Node reference/tag reference/attrs reference/children) (#Node sample/tag sample/attrs sample/children)] (and (ident/= reference/tag sample/tag) - (:: (d;Eq<Dict> text;Eq<Text>) = reference/attrs sample/attrs) - (n/= (list;size reference/children) - (list;size sample/children)) - (|> (list;zip2 reference/children sample/children) - (list;every? (product;uncurry =)))) + (:: (d.Eq<Dict> text.Eq<Text>) = reference/attrs sample/attrs) + (n/= (list.size reference/children) + (list.size sample/children)) + (|> (list.zip2 reference/children sample/children) + (list.every? (product.uncurry =)))) _ false))) (type: #export (Reader a) - (p;Parser (List XML) a)) + (p.Parser (List XML) a)) (exception: #export Empty-Input) (exception: #export Unexpected-Input) @@ -256,81 +255,81 @@ (Reader Text) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) + (#.Cons head tail) (case head (#Text value) - (#E;Success [tail value]) + (#E.Success [tail value]) (#Node _) - (ex;throw Unexpected-Input ""))))) + (ex.throw Unexpected-Input ""))))) (def: #export (attr name) (-> Ident (Reader Text)) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head _) + (#.Cons head _) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node tag attrs children) - (case (d;get name attrs) - #;None - (ex;throw Unknown-Attribute "") + (case (d.get name attrs) + #.None + (ex.throw Unknown-Attribute "") - (#;Some value) - (#E;Success [docs value])))))) + (#.Some value) + (#E.Success [docs value])))))) (def: (run' docs reader) - (All [a] (-> (List XML) (Reader a) (E;Error a))) - (case (p;run docs reader) - (#E;Success [remaining output]) - (if (list;empty? remaining) - (#E;Success output) - (ex;throw Unconsumed-Inputs (|> remaining + (All [a] (-> (List XML) (Reader a) (E.Error a))) + (case (p.run docs reader) + (#E.Success [remaining output]) + (if (list.empty? remaining) + (#E.Success output) + (ex.throw Unconsumed-Inputs (|> remaining (L/map (:: Codec<Text,XML> encode)) - (text;join-with "\n\n")))) + (text.join-with "\n\n")))) - (#E;Error error) - (#E;Error error))) + (#E.Error error) + (#E.Error error))) (def: #export (node tag) (-> Ident (Reader Unit)) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head _) + (#.Cons head _) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node _tag _attrs _children) (if (ident/= tag _tag) - (#E;Success [docs []]) - (ex;throw Wrong-Tag (ident/encode tag))))))) + (#E.Success [docs []]) + (ex.throw Wrong-Tag (ident/encode tag))))))) (def: #export (children reader) (All [a] (-> (Reader a) (Reader a))) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) + (#.Cons head tail) (case head (#Text _) - (ex;throw Unexpected-Input "") + (ex.throw Unexpected-Input "") (#Node _tag _attrs _children) - (do E;Monad<Error> + (do E.Monad<Error> [output (run' _children reader)] (wrap [tail output])))))) @@ -338,12 +337,12 @@ (Reader Unit) (function [docs] (case docs - #;Nil - (ex;throw Empty-Input "") + #.Nil + (ex.throw Empty-Input "") - (#;Cons head tail) - (#E;Success [tail []])))) + (#.Cons head tail) + (#E.Success [tail []])))) (def: #export (run document reader) - (All [a] (-> XML (Reader a) (E;Error a))) + (All [a] (-> XML (Reader a) (E.Error a))) (run' (list document) reader)) diff --git a/stdlib/source/lux/data/ident.lux b/stdlib/source/lux/data/ident.lux index 57e742433..feb456d94 100644 --- a/stdlib/source/lux/data/ident.lux +++ b/stdlib/source/lux/data/ident.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq] [codec #+ Codec] @@ -29,24 +29,24 @@ (def: (encode [module name]) (case module "" name - _ ($_ text/compose module ";" name))) + _ ($_ text/compose module "." name))) (def: (decode input) (if (text/= "" input) - (#;Left (text/compose "Invalid format for Ident: " input)) - (case (text;split-all-with ";" input) + (#.Left (text/compose "Invalid format for Ident: " input)) + (case (text.split-all-with "." input) (^ (list name)) - (#;Right ["" name]) + (#.Right ["" name]) (^ (list module name)) - (#;Right [module name]) + (#.Right [module name]) _ - (#;Left (text/compose "Invalid format for Ident: " input)))))) + (#.Left (text/compose "Invalid format for Ident: " input)))))) (struct: #export _ (Hash Ident) (def: eq Eq<Ident>) (def: (hash [module name]) - (let [(^open) text;Hash<Text>] + (let [(^open) text.Hash<Text>] (n/+ (hash module) (hash name))))) diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux index d2335f121..919c2385f 100644 --- a/stdlib/source/lux/data/identity.lux +++ b/stdlib/source/lux/data/identity.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux/control ["F" functor] ["A" applicative] @@ -10,10 +10,10 @@ a) ## [Structures] -(struct: #export _ (F;Functor Identity) +(struct: #export _ (F.Functor Identity) (def: map id)) -(struct: #export _ (A;Applicative Identity) +(struct: #export _ (A.Applicative Identity) (def: functor Functor<Identity>) (def: wrap id) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 86fdde4a4..75b5e29e2 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [functor #+ Functor] @@ -14,15 +14,15 @@ (def: #hidden (freeze' generator) (All [a] (-> (-> [] a) (Lazy a))) - (let [cache (atom;atom (: (Maybe ($ +0)) #;None))] + (let [cache (atom.atom (: (Maybe ($ +0)) #.None))] (@opaque (function [_] - (case (io;run (atom;read cache)) - (#;Some value) + (case (io.run (atom.read cache)) + (#.Some value) value _ (let [value (generator [])] - (exec (io;run (atom;compare-and-swap _ (#;Some value) cache)) + (exec (io.run (atom.compare-and-swap _ (#.Some value) cache)) value))))))) (def: #export (thaw l-value) @@ -31,7 +31,7 @@ (syntax: #export (freeze expr) (do @ - [g!_ (macro;gensym "_")] + [g!_ (macro.gensym "_")] (wrap (list (` (freeze' (function [(~ g!_)] (~ expr)))))))) (struct: #export _ (Functor Lazy) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 3c247eea3..02d109981 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["m" monoid] ["F" functor] @@ -8,52 +8,52 @@ ## [Types] ## (type: (Maybe a) -## #;None -## (#;Some a)) +## #.None +## (#.Some a)) ## [Structures] -(struct: #export Monoid<Maybe> (All [a] (m;Monoid (Maybe a))) - (def: identity #;None) +(struct: #export Monoid<Maybe> (All [a] (m.Monoid (Maybe a))) + (def: identity #.None) (def: (compose xs ys) (case xs - #;None ys - (#;Some x) (#;Some x)))) + #.None ys + (#.Some x) (#.Some x)))) -(struct: #export _ (F;Functor Maybe) +(struct: #export _ (F.Functor Maybe) (def: (map f ma) (case ma - #;None #;None - (#;Some a) (#;Some (f a))))) + #.None #.None + (#.Some a) (#.Some (f a))))) -(struct: #export _ (A;Applicative Maybe) +(struct: #export _ (A.Applicative Maybe) (def: functor Functor<Maybe>) (def: (wrap x) - (#;Some x)) + (#.Some x)) (def: (apply ff fa) (case [ff fa] - [(#;Some f) (#;Some a)] - (#;Some (f a)) + [(#.Some f) (#.Some a)] + (#.Some (f a)) _ - #;None))) + #.None))) (struct: #export _ (Monad Maybe) (def: applicative Applicative<Maybe>) (def: (join mma) (case mma - #;None #;None - (#;Some xs) xs))) + #.None #.None + (#.Some xs) xs))) (struct: #export (Eq<Maybe> Eq<a>) (All [a] (-> (Eq a) (Eq (Maybe a)))) (def: (= mx my) (case [mx my] - [#;None #;None] + [#.None #.None] true - [(#;Some x) (#;Some y)] + [(#.Some x) (#.Some y)] (:: Eq<a> = x y) _ @@ -61,40 +61,40 @@ (struct: #export (MaybeT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a)))))) - (def: applicative (A;compose (get@ #monad;applicative Monad<M>) Applicative<Maybe>)) + (def: applicative (A.compose (get@ #monad.applicative Monad<M>) Applicative<Maybe>)) (def: (join MmMma) (do Monad<M> [mMma MmMma] (case mMma - #;None - (wrap #;None) + #.None + (wrap #.None) - (#;Some Mma) + (#.Some Mma) Mma)))) (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) - (monad;lift Monad<M> (:: Monad<Maybe> wrap))) + (monad.lift Monad<M> (:: Monad<Maybe> wrap))) (macro: #export (default tokens state) - {#;doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #;None. - (default 20 (#;Some 10)) => 10 + {#.doc "## Allows you to provide a default value that will be used + ## if a (Maybe x) value turns out to be #.None. + (default 20 (#.Some 10)) => 10 - (default 20 #;None) => 20"} + (default 20 #.None) => 20"} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-cursor (#;Symbol ["" ""])]) + (let [g!temp (: Code [dummy-cursor (#.Symbol ["" ""])]) code (` (case (~ maybe) - (#;Some (~ g!temp)) + (#.Some (~ g!temp)) (~ g!temp) - #;None + #.None (~ else)))] - (#;Right [state (list code)])) + (#.Right [state (list code)])) _ - (#;Left "Wrong syntax for default"))) + (#.Left "Wrong syntax for default"))) (def: #export assume (All [a] (-> (Maybe a) a)) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index de8ba5242..388fa6174 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Implementations of common structures for Lux's primitive number types."} +(.module: {#.doc "Implementations of common structures for Lux's primitive number types."} lux (lux (control number [monoid #+ Monoid] @@ -24,7 +24,7 @@ ) (do-template [<type> <eq> <lt> <lte> <gt> <gte>] - [(struct: #export _ (order;Order <type>) + [(struct: #export _ (order.Order <type>) (def: eq <eq>) (def: < <lt>) (def: <= <lte>) @@ -134,7 +134,7 @@ (do-template [<name> <const> <doc>] [(def: #export <name> - {#;doc <doc>} + {#.doc <doc>} Frac (<const>))] @@ -144,7 +144,7 @@ ) (def: #export (not-a-number? number) - {#;doc "Tests whether a frac is actually not-a-number."} + {#.doc "Tests whether a frac is actually not-a-number."} (-> Frac Bool) (not (f/= number number))) @@ -161,11 +161,11 @@ (def: (decode input) (case (<decoder> [input]) - (#;Some value) - (#e;Success value) + (#.Some value) + (#e.Success value) - #;None - (#e;Error <error>))))] + #.None + (#e.Error <error>))))] [Frac "lux frac encode" "lux frac decode" "Could not decode Frac"] ) @@ -180,7 +180,7 @@ (def: (encode value) (loop [input value output ""] - (let [digit (maybe;assume (get-char <char-set> (n/% <base> input))) + (let [digit (maybe.assume (get-char <char-set> (n/% <base> input))) output' ("lux text concat" digit output) input' (n// <base> input)] (if (n/= +0 input') @@ -191,24 +191,24 @@ (let [input-size ("lux text size" repr)] (if (n/>= +2 input-size) (case ("lux text char" repr +0) - (^ (#;Some (char "+"))) + (^ (#.Some (char "+"))) (let [input ("lux text upper" repr)] (loop [idx +1 output +0] (if (n/< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (maybe.assume (get-char input idx))] (case ("lux text index" <char-set> digit +0) - #;None - (#e;Error ("lux text concat" <error> repr)) + #.None + (#e.Error ("lux text concat" <error> repr)) - (#;Some index) + (#.Some index) (recur (n/inc idx) (|> output (n/* <base>) (n/+ index))))) - (#e;Success output)))) + (#e.Success output)))) _ - (#e;Error ("lux text concat" <error> repr))) - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))) + (#e.Error ("lux text concat" <error> repr))))))] [Binary@Codec<Text,Nat> +2 "01" "Invalid binary syntax for Nat: "] [Octal@Codec<Text,Nat> +8 "01234567" "Invalid octal syntax for Nat: "] @@ -227,10 +227,10 @@ (loop [input (|> value (i// <base>) (:: Number<Int> abs)) output (|> value (i/% <base>) (:: Number<Int> abs) int-to-nat (get-char <char-set>) - maybe;assume)] + maybe.assume)] (if (i/= 0 input) ("lux text concat" sign output) - (let [digit (maybe;assume (get-char <char-set> (int-to-nat (i/% <base> input))))] + (let [digit (maybe.assume (get-char <char-set> (int-to-nat (i/% <base> input))))] (recur (i// <base> input) ("lux text concat" digit output)))))))) @@ -238,7 +238,7 @@ (let [input-size ("lux text size" repr)] (if (n/>= +1 input-size) (let [sign (case (get-char repr +0) - (^ (#;Some "-")) + (^ (#.Some "-")) -1 _ @@ -247,16 +247,16 @@ (loop [idx (if (i/= -1 sign) +1 +0) output 0] (if (n/< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (maybe.assume (get-char input idx))] (case ("lux text index" <char-set> digit +0) - #;None - (#e;Error <error>) + #.None + (#e.Error <error>) - (#;Some index) + (#.Some index) (recur (n/inc idx) (|> output (i/* <base>) (i/+ (:! Int index)))))) - (#e;Success (i/* sign output))))) - (#e;Error <error>)))))] + (#e.Success (i/* sign output))))) + (#e.Error <error>)))))] [Binary@Codec<Text,Int> 2 "01" "Invalid binary syntax for Int: "] [Octal@Codec<Text,Int> 8 "01234567" "Invalid octal syntax for Int: "] @@ -266,7 +266,7 @@ (def: (de-prefix input) (-> Text Text) - (maybe;assume ("lux text clip" input +1 ("lux text size" input)))) + (maybe.assume ("lux text clip" input +1 ("lux text size" input)))) (do-template [<struct> <nat> <char-bit-size> <error>] [(struct: #export <struct> (Codec Text Deg) @@ -287,14 +287,14 @@ (let [repr-size ("lux text size" repr)] (if (n/>= +2 repr-size) (case ("lux text char" repr +0) - (^multi (^ (#;Some (char "."))) + (^multi (^ (#.Some (char "."))) [(:: <nat> decode ("lux text concat" "+" (de-prefix repr))) - (#e;Success output)]) - (#e;Success (:! Deg output)) + (#e.Success output)]) + (#e.Success (:! Deg output)) _ - (#e;Error ("lux text concat" <error> repr))) - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))) + (#e.Error ("lux text concat" <error> repr))))))] [Binary@Codec<Text,Deg> Binary@Codec<Text,Nat> +1 "Invalid binary syntax: "] [Octal@Codec<Text,Deg> Octal@Codec<Text,Nat> +3 "Invalid octal syntax: "] @@ -315,19 +315,19 @@ ("lux text concat" "." output) (let [shifted (f/* <base> dec-left) digit (|> shifted (f/% <base>) frac-to-int int-to-nat - (get-char <char-set>) maybe;assume)] + (get-char <char-set>) maybe.assume)] (recur (f/% 1.0 shifted) ("lux text concat" output digit))))))] ("lux text concat" whole-part decimal-part))) (def: (decode repr) (case ("lux text index" repr "." +0) - (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr +0 split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr)))] + (#.Some split-index) + (let [whole-part (maybe.assume ("lux text clip" repr +0 split-index)) + decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr)))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] - (^multi [(#e;Success whole) (#e;Success decimal)] + (^multi [(#e.Success whole) (#e.Success decimal)] (i/>= 0 decimal)) (let [sign (if (i/< 0 whole) -1.0 @@ -340,19 +340,19 @@ (f/* <base> output)))) adjusted-decimal (|> decimal int-to-frac (f// div-power)) dec-deg (case (:: Hex@Codec<Text,Deg> decode ("lux text concat" "." decimal-part)) - (#e;Success dec-deg) + (#e.Success dec-deg) dec-deg - (#e;Error error) + (#e.Error error) (error! error))] - (#e;Success (f/+ (int-to-frac whole) + (#e.Success (f/+ (int-to-frac whole) (f/* sign adjusted-decimal)))) _ - (#e;Error ("lux text concat" <error> repr)))) + (#e.Error ("lux text concat" <error> repr)))) _ - (#e;Error ("lux text concat" <error> repr)))))] + (#e.Error ("lux text concat" <error> repr)))))] [Binary@Codec<Text,Frac> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "] ) @@ -368,8 +368,8 @@ (if (n/<= chunk-size num-digits) (list digits) (let [boundary (n/- chunk-size num-digits) - chunk (maybe;assume ("lux text clip" digits boundary num-digits)) - remaining (maybe;assume ("lux text clip" digits +0 boundary))] + chunk (maybe.assume ("lux text clip" digits boundary num-digits)) + remaining (maybe.assume ("lux text clip" digits +0 boundary))] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -443,19 +443,19 @@ (def: (map f xs) (All [a b] (-> (-> a b) (List a) (List b))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons x xs') - (#;Cons (f x) (map f xs')))) + (#.Cons x xs') + (#.Cons (f x) (map f xs')))) (def: (re-join-chunks xs) (-> (List Text) Text) (case xs - #;Nil + #.Nil "" - (#;Cons x xs') + (#.Cons x xs') ("lux text concat" x (re-join-chunks xs')))) (do-template [<from> <from-translator> <to> <to-translator> <base-bits>] @@ -497,11 +497,11 @@ (def: (encode value) (let [sign (:: Number<Frac> signum value) raw-bin (:: Binary@Codec<Text,Frac> encode value) - dot-idx (maybe;assume ("lux text index" raw-bin "." +0)) - whole-part (maybe;assume ("lux text clip" raw-bin + dot-idx (maybe.assume ("lux text index" raw-bin "." +0)) + whole-part (maybe.assume ("lux text clip" raw-bin (if (f/= -1.0 sign) +1 +0) dot-idx)) - decimal-part (maybe;assume ("lux text clip" raw-bin (n/inc dot-idx) ("lux text size" raw-bin))) + decimal-part (maybe.assume ("lux text clip" raw-bin (n/inc dot-idx) ("lux text size" raw-bin))) hex-output (|> (<from> false decimal-part) ("lux text concat" ".") ("lux text concat" (<from> true whole-part)) @@ -510,28 +510,28 @@ (def: (decode repr) (let [sign (case ("lux text index" repr "-" +0) - (#;Some +0) + (#.Some +0) -1.0 _ 1.0)] (case ("lux text index" repr "." +0) - (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr))) + (#.Some split-index) + (let [whole-part (maybe.assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index)) + decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr))) as-binary (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> whole-part)) ("lux text concat" (if (f/= -1.0 sign) "-" "")))] (case (:: Binary@Codec<Text,Frac> decode as-binary) - (#e;Error _) - (#e;Error ("lux text concat" <error> repr)) + (#e.Error _) + (#e.Error ("lux text concat" <error> repr)) output output)) _ - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))))))] [Octal@Codec<Text,Frac> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary] [Hex@Codec<Text,Frac> "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary] @@ -539,30 +539,30 @@ (do-template [<macro> <nat> <int> <deg> <frac> <error> <doc>] [(macro: #export (<macro> tokens state) - {#;doc <doc>} + {#.doc <doc>} (case tokens - (#;Cons [meta (#;Text repr)] #;Nil) + (#.Cons [meta (#.Text repr)] #.Nil) (case (:: <nat> decode repr) - (#e;Success value) - (#e;Success [state (list [meta (#;Nat value)])]) + (#e.Success value) + (#e.Success [state (list [meta (#.Nat value)])]) - (^multi (#e;Error _) - [(:: <int> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Int value)])]) + (^multi (#e.Error _) + [(:: <int> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Int value)])]) - (^multi (#e;Error _) - [(:: <deg> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Deg value)])]) + (^multi (#e.Error _) + [(:: <deg> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Deg value)])]) - (^multi (#e;Error _) - [(:: <frac> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Frac value)])]) + (^multi (#e.Error _) + [(:: <frac> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Frac value)])]) _ - (#e;Error <error>)) + (#e.Error <error>)) _ - (#e;Error <error>)))] + (#e.Error <error>)))] [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Frac> "Invalid binary syntax." @@ -592,11 +592,11 @@ (def: (make-digits _) (-> Top Digits) - ("lux array new" bit;width)) + ("lux array new" bit.width)) (def: (digits-get idx digits) (-> Nat Digits Nat) - (maybe;default +0 ("lux array get" digits idx))) + (maybe.default +0 ("lux array get" digits idx))) (def: (digits-put idx digit digits) (-> Nat Nat Digits Digits) @@ -632,7 +632,7 @@ (def: (digits-to-text digits) (-> Digits Text) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) all-zeroes? true output ""] (if (i/>= 0 (:! Int idx)) @@ -651,7 +651,7 @@ (def: (digits-add param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) carry +0 output (make-digits [])] (if (i/>= 0 (:! Int idx)) @@ -667,25 +667,25 @@ (def: (text-to-digits input) (-> Text (Maybe Digits)) (let [length ("lux text size" input)] - (if (n/<= bit;width length) + (if (n/<= bit.width length) (loop [idx +0 output (make-digits [])] (if (n/< length idx) - (let [char (maybe;assume (get-char input idx))] + (let [char (maybe.assume (get-char input idx))] (case ("lux text index" "0123456789" char +0) - #;None - #;None + #.None + #.None - (#;Some digit) + (#.Some digit) (recur (n/inc idx) (digits-put idx digit output)))) - (#;Some output))) - #;None))) + (#.Some output))) + #.None))) (def: (digits-lt param subject) (-> Digits Digits Bool) (loop [idx +0] - (and (n/< bit;width idx) + (and (n/< bit.width idx) (let [pd (digits-get idx param) sd (digits-get idx subject)] (if (n/= pd sd) @@ -706,7 +706,7 @@ (def: (digits-sub! param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) output subject] (if (i/>= 0 (nat-to-int idx)) (recur (n/dec idx) @@ -716,13 +716,13 @@ (struct: #export _ (Codec Text Deg) (def: (encode input) (let [input (:! Nat input) - last-idx (n/dec bit;width)] + last-idx (n/dec bit.width)] (if (n/= +0 input) ".0" (loop [idx last-idx digits (make-digits [])] (if (i/>= 0 (:! Int idx)) - (if (bit;set? idx input) + (if (bit.set? idx input) (let [digits' (digits-add (digits-power (n/- idx last-idx)) digits)] (recur (n/dec idx) @@ -735,33 +735,33 @@ (def: (decode input) (let [length ("lux text size" input) dotted? (case ("lux text index" input "." +0) - (#;Some +0) + (#.Some +0) true _ false)] (if (and dotted? - (n/<= (n/inc bit;width) length)) + (n/<= (n/inc bit.width) length)) (case (|> ("lux text clip" input +1 length) - maybe;assume + maybe.assume text-to-digits) - (#;Some digits) + (#.Some digits) (loop [digits digits idx +0 output +0] - (if (n/< bit;width idx) + (if (n/< bit.width idx) (let [power (digits-power idx)] (if (digits-lt power digits) ## Skip power (recur digits (n/inc idx) output) (recur (digits-sub! power digits) (n/inc idx) - (bit;set (n/- idx (n/dec bit;width)) output)))) - (#e;Success (:! Deg output)))) + (bit.set (n/- idx (n/dec bit.width)) output)))) + (#e.Success (:! Deg output)))) - #;None - (#e;Error ("lux text concat" "Wrong syntax for Deg: " input))) - (#e;Error ("lux text concat" "Wrong syntax for Deg: " input)))) + #.None + (#e.Error ("lux text concat" "Wrong syntax for Deg: " input))) + (#e.Error ("lux text concat" "Wrong syntax for Deg: " input)))) )) (def: (log2 input) @@ -797,26 +797,26 @@ (let [sign (:: Number<Frac> signum input) input (:: Number<Frac> abs input) exponent ("lux math floor" (log2 input)) - exponent-mask (|> +1 (bit;shift-left exponent-size) n/dec) + exponent-mask (|> +1 (bit.shift-left exponent-size) n/dec) mantissa (|> input ## Normalize (f// ("lux math pow" 2.0 exponent)) ## Make it int-equivalent (f/* ("lux math pow" 2.0 52.0))) sign-bit (if (f/= -1.0 sign) +1 +0) - exponent-bits (|> exponent frac-to-int int-to-nat (n/+ double-bias) (bit;and exponent-mask)) + exponent-bits (|> exponent frac-to-int int-to-nat (n/+ double-bias) (bit.and exponent-mask)) mantissa-bits (|> mantissa frac-to-int int-to-nat)] - ($_ bit;or - (bit;shift-left +63 sign-bit) - (bit;shift-left mantissa-size exponent-bits) - (bit;clear mantissa-size mantissa-bits))) + ($_ bit.or + (bit.shift-left +63 sign-bit) + (bit.shift-left mantissa-size exponent-bits) + (bit.clear mantissa-size mantissa-bits))) )) (do-template [<getter> <mask> <size> <offset>] - [(def: <mask> (|> +1 (bit;shift-left <size>) n/dec (bit;shift-left <offset>))) + [(def: <mask> (|> +1 (bit.shift-left <size>) n/dec (bit.shift-left <offset>))) (def: (<getter> input) (-> Nat Nat) - (|> input (bit;and <mask>) (bit;shift-right <offset>)))] + (|> input (bit.and <mask>) (bit.shift-right <offset>)))] [mantissa mantissa-mask mantissa-size +0] [exponent exponent-mask exponent-size mantissa-size] @@ -841,7 +841,7 @@ (f/* -1.0 0.0)) ## else - (let [normalized (|> M (bit;set mantissa-size) + (let [normalized (|> M (bit.set mantissa-size) nat-to-int int-to-frac (f// ("lux math pow" 2.0 52.0))) power (|> E (n/- double-bias) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 783c8eb81..d17180530 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Complex arithmetic."} +(.module: {#.doc "Complex arithmetic."} lux (lux [math] (control [eq #+ Eq] @@ -20,13 +20,13 @@ {#real Frac #imaginary Frac}) -(syntax: #export (complex real [?imaginary (p;maybe s;any)]) - {#;doc (doc "Complex literals." +(syntax: #export (complex real [?imaginary (p.maybe s.any)]) + {#.doc (doc "Complex literals." (complex real imaginary) "The imaginary part can be omitted if it's 0." (complex real))} - (wrap (list (` {#;;real (~ real) - #;;imaginary (~ (maybe;default (' 0.0) + (wrap (list (` {#..real (~ real) + #..imaginary (~ (maybe.default (' 0.0) ?imaginary))})))) (def: #export i Complex (complex 0.0 1.0)) @@ -36,8 +36,8 @@ (def: #export zero Complex (complex 0.0 0.0)) (def: #export (not-a-number? complex) - (or (number;not-a-number? (get@ #real complex)) - (number;not-a-number? (get@ #imaginary complex)))) + (or (number.not-a-number? (get@ #real complex)) + (number.not-a-number? (get@ #imaginary complex)))) (def: #export (c/= param input) (-> Complex Complex Bool) @@ -117,60 +117,60 @@ (-> Complex Complex Complex) (let [scaled (c// param input) quotient (|> scaled - (update@ #real math;floor) - (update@ #imaginary math;floor))] + (update@ #real math.floor) + (update@ #imaginary math.floor))] (c/- (c/* quotient param) input))) (def: #export (cos subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cosh imaginary) - (math;cos real)) - #imaginary (f/* (math;sinh imaginary) - (frac/negate (math;sin real)))})) + {#real (f/* (math.cosh imaginary) + (math.cos real)) + #imaginary (f/* (math.sinh imaginary) + (frac/negate (math.sin real)))})) (def: #export (cosh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cos imaginary) - (math;cosh real)) - #imaginary (f/* (math;sin imaginary) - (math;sinh real))})) + {#real (f/* (math.cos imaginary) + (math.cosh real)) + #imaginary (f/* (math.sin imaginary) + (math.sinh real))})) (def: #export (sin subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cosh imaginary) - (math;sin real)) - #imaginary (f/* (math;sinh imaginary) - (math;cos real))})) + {#real (f/* (math.cosh imaginary) + (math.sin real)) + #imaginary (f/* (math.sinh imaginary) + (math.cos real))})) (def: #export (sinh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (f/* (math;cos imaginary) - (math;sinh real)) - #imaginary (f/* (math;sin imaginary) - (math;cosh real))})) + {#real (f/* (math.cos imaginary) + (math.sinh real)) + #imaginary (f/* (math.sin imaginary) + (math.cosh real))})) (def: #export (tan subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject r2 (f/* 2.0 real) i2 (f/* 2.0 imaginary) - d (f/+ (math;cos r2) (math;cosh i2))] - {#real (f// d (math;sin r2)) - #imaginary (f// d (math;sinh i2))})) + d (f/+ (math.cos r2) (math.cosh i2))] + {#real (f// d (math.sin r2)) + #imaginary (f// d (math.sinh i2))})) (def: #export (tanh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject r2 (f/* 2.0 real) i2 (f/* 2.0 imaginary) - d (f/+ (math;cosh r2) (math;cos i2))] - {#real (f// d (math;sinh r2)) - #imaginary (f// d (math;sin i2))})) + d (f/+ (math.cosh r2) (math.cos i2))] + {#real (f// d (math.sinh r2)) + #imaginary (f// d (math.sin i2))})) (def: #export (c/abs subject) (-> Complex Complex) @@ -180,12 +180,12 @@ (if (f/= 0.0 imaginary) (frac/abs real) (let [q (f// imaginary real)] - (f/* (math;root2 (f/+ 1.0 (f/* q q))) + (f/* (math.root2 (f/+ 1.0 (f/* q q))) (frac/abs imaginary)))) (if (f/= 0.0 real) (frac/abs imaginary) (let [q (f// real imaginary)] - (f/* (math;root2 (f/+ 1.0 (f/* q q))) + (f/* (math.root2 (f/+ 1.0 (f/* q q))) (frac/abs real)))) )))) @@ -208,15 +208,15 @@ (def: #export (exp subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject - r-exp (math;exp real)] - {#real (f/* r-exp (math;cos imaginary)) - #imaginary (f/* r-exp (math;sin imaginary))})) + r-exp (math.exp real)] + {#real (f/* r-exp (math.cos imaginary)) + #imaginary (f/* r-exp (math.sin imaginary))})) (def: #export (log subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (|> subject c/abs (get@ #real) math;log) - #imaginary (math;atan2 real imaginary)})) + {#real (|> subject c/abs (get@ #real) math.log) + #imaginary (math.atan2 real imaginary)})) (do-template [<name> <type> <op>] [(def: #export (<name> param input) @@ -233,7 +233,7 @@ (def: #export (root2 (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input c/abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) math;root2)] + (let [t (|> input c/abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) math.root2)] (if (f/>= 0.0 real) {#real t #imaginary (f// (f/* 2.0 t) @@ -286,24 +286,24 @@ (def: #export (argument (^slots [#real #imaginary])) (-> Complex Frac) - (math;atan2 real imaginary)) + (math.atan2 real imaginary)) (def: #export (nth-roots nth input) (-> Nat Complex (List Complex)) (if (n/= +0 nth) (list) (let [r-nth (|> nth nat-to-int int-to-frac) - nth-root-of-abs (|> input c/abs (get@ #real) (math;pow (f// r-nth 1.0))) + nth-root-of-abs (|> input c/abs (get@ #real) (math.pow (f// r-nth 1.0))) nth-phi (|> input argument (f// r-nth)) - slice (|> math;pi (f/* 2.0) (f// r-nth))] - (|> (list;n/range +0 (n/dec nth)) + slice (|> math.pi (f/* 2.0) (f// r-nth))] + (|> (list.n/range +0 (n/dec nth)) (L/map (function [nth'] (let [inner (|> nth' nat-to-int int-to-frac (f/* slice) (f/+ nth-phi)) real (f/* nth-root-of-abs - (math;cos inner)) + (math.cos inner)) imaginary (f/* nth-root-of-abs - (math;sin inner))] + (math.sin inner))] {#real real #imaginary imaginary}))))))) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 23e128464..6f5b64f5e 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Rational arithmetic."} +(.module: {#.doc "Rational arithmetic."} lux (lux [math] (control [eq #+ Eq] @@ -23,7 +23,7 @@ (def: #hidden (normalize (^slots [#numerator #denominator])) (-> Ratio Ratio) - (let [common (math;gcd numerator denominator)] + (let [common (math.gcd numerator denominator)] {#numerator (n// common numerator) #denominator (n// common denominator)})) @@ -103,7 +103,7 @@ (struct: #export _ (Eq Ratio) (def: = r/=)) -(struct: #export _ (order;Order Ratio) +(struct: #export _ (order.Order Ratio) (def: eq Eq<Ratio>) (def: < r/<) (def: <= r/<=) @@ -128,10 +128,10 @@ (def: part-encode (-> Nat Text) - (|>> n/encode (text;split +1) maybe;assume product;right)) + (|>> n/encode (text.split +1) maybe.assume product.right)) (def: part-decode - (-> Text (E;Error Nat)) + (-> Text (E.Error Nat)) (|>> (format "+") n/decode)) (struct: #export _ (Codec Text Ratio) @@ -139,22 +139,22 @@ ($_ Text/compose (part-encode numerator) separator (part-encode denominator))) (def: (decode input) - (case (text;split-with separator input) - (#;Some [num denom]) - (do E;Monad<Error> + (case (text.split-with separator input) + (#.Some [num denom]) + (do E.Monad<Error> [numerator (part-decode num) denominator (part-decode denom)] (wrap (normalize {#numerator numerator #denominator denominator}))) - #;None - (#;Left (Text/compose "Invalid syntax for ratio: " input))))) + #.None + (#.Left (Text/compose "Invalid syntax for ratio: " input))))) -(syntax: #export (ratio numerator [?denominator (p;maybe s;any)]) - {#;doc (doc "Rational literals." +(syntax: #export (ratio numerator [?denominator (p.maybe s.any)]) + {#.doc (doc "Rational literals." (ratio numerator denominator) "The denominator can be omitted if it's 1." (ratio numerator))} - (wrap (list (` (normalize {#;;numerator (~ numerator) - #;;denominator (~ (maybe;default (' +1) + (wrap (list (` (normalize {#..numerator (~ numerator) + #..denominator (~ (maybe.default (' +1) ?denominator))}))))) diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux index d38350929..712e96437 100644 --- a/stdlib/source/lux/data/product.lux +++ b/stdlib/source/lux/data/product.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for working with tuples (particularly 2-tuples)."} +(.module: {#.doc "Functionality for working with tuples (particularly 2-tuples)."} lux) ## [Functions] diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux index 535254ad9..70fd022f4 100644 --- a/stdlib/source/lux/data/store.lux +++ b/stdlib/source/lux/data/store.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["F" functor] comonad) @@ -13,7 +13,7 @@ {#cursor (get@ #cursor wa) #peek (function [s] (f (set@ #cursor s wa)))}) -(struct: #export Functor<Store> (All [s] (F;Functor (Store s))) +(struct: #export Functor<Store> (All [s] (F.Functor (Store s))) (def: (map f fa) (extend (function [store] (f (:: store peek (:: store cursor)))) @@ -39,5 +39,5 @@ (|> store (::: split) (peeks change))) (def: #export (experiment Functor<f> change store) - (All [f s a] (-> (F;Functor f) (-> s (f s)) (Store s a) (f a))) + (All [f s a] (-> (F.Functor f) (-> s (f s)) (Store s a) (f a))) (:: Functor<f> map (::: peek) (change (::: cursor)))) diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux index 2c71f67d4..c2373c238 100644 --- a/stdlib/source/lux/data/sum.lux +++ b/stdlib/source/lux/data/sum.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functionality for working with variants (particularly 2-variants)."} +(.module: {#.doc "Functionality for working with variants (particularly 2-variants)."} lux) ## [Values] @@ -22,9 +22,9 @@ [(def: #export (<name> es) (All [a b] (-> (List (| a b)) (List <side>))) (case es - #;Nil #;Nil - (#;Cons (<tag> x) es') (#;Cons [x (<name> es')]) - (#;Cons _ es') (<name> es')))] + #.Nil #.Nil + (#.Cons (<tag> x) es') (#.Cons [x (<name> es')]) + (#.Cons _ es') (<name> es')))] [lefts a +0] [rights b +1] @@ -33,11 +33,11 @@ (def: #export (partition xs) (All [a b] (-> (List (| a b)) [(List a) (List b)])) (case xs - #;Nil - [#;Nil #;Nil] + #.Nil + [#.Nil #.Nil] - (#;Cons x xs') + (#.Cons x xs') (let [[lefts rights] (partition xs')] (case x - (+0 x') [(#;Cons x' lefts) rights] - (+1 x') [lefts (#;Cons x' rights)])))) + (+0 x') [(#.Cons x' lefts) rights] + (+1 x') [lefts (#.Cons x' rights)])))) diff --git a/stdlib/source/lux/data/tainted.lux b/stdlib/source/lux/data/tainted.lux index d65e9c56b..2190c3712 100644 --- a/stdlib/source/lux/data/tainted.lux +++ b/stdlib/source/lux/data/tainted.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [product]) (type opaque))) @@ -18,8 +18,8 @@ (All [a] (-> (-> a Bool) (Tainted a) (Maybe a))) (let [value (trust tainted)] (if (pred value) - (#;Some value) - #;None))) + (#.Some value) + #.None))) (def: #export (sanitize f tainted) (All [a] (-> (-> a a) (Tainted a) a)) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index bf05df201..0fdbb376f 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [eq #+ Eq] @@ -21,7 +21,7 @@ (def: #export (contains? sub text) (-> Text Text Bool) (case ("lux text index" text sub +0) - (#;Some _) + (#.Some _) true _ @@ -59,34 +59,34 @@ (def: (last-index-of'' part part-size since text) (-> Text Nat Nat Text (Maybe Nat)) (case ("lux text index" text part (n/+ part-size since)) - #;None - (#;Some since) + #.None + (#.Some since) - (#;Some since') + (#.Some since') (last-index-of'' part part-size since' text))) (def: #export (last-index-of' part from text) (-> Text Nat Text (Maybe Nat)) (case ("lux text index" text part from) - (#;Some since) + (#.Some since) (last-index-of'' part ("lux text size" part) since text) - #;None - #;None)) + #.None + #.None)) (def: #export (last-index-of part text) (-> Text Text (Maybe Nat)) (case ("lux text index" text part +0) - (#;Some since) + (#.Some since) (last-index-of'' part ("lux text size" part) since text) - #;None - #;None)) + #.None + #.None)) (def: #export (starts-with? prefix x) (-> Text Text Bool) (case (index-of prefix x) - (#;Some +0) + (#.Some +0) true _ @@ -95,7 +95,7 @@ (def: #export (ends-with? postfix x) (-> Text Text Bool) (case (last-index-of postfix x) - (#;Some n) + (#.Some n) (n/= (size x) (n/+ (size postfix) n)) @@ -105,15 +105,15 @@ (def: #export (split at x) (-> Nat Text (Maybe [Text Text])) (case [(clip +0 at x) (clip' at x)] - [(#;Some pre) (#;Some post)] - (#;Some [pre post]) + [(#.Some pre) (#.Some post)] + (#.Some [pre post]) _ - #;None)) + #.None)) (def: #export (split-with token sample) (-> Text Text (Maybe [Text Text])) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [index (index-of token sample) [pre post'] (split index sample) [_ post] (split (size token) post')] @@ -122,11 +122,11 @@ (def: #export (split-all-with token sample) (-> Text Text (List Text)) (case (split-with token sample) - (#;Some [pre post]) - (#;Cons pre (split-all-with token post)) + (#.Some [pre post]) + (#.Cons pre (split-all-with token post)) - #;None - (#;Cons sample #;Nil))) + #.None + (#.Cons sample #.Nil))) (def: #export split-lines (split-all-with "\n")) @@ -136,7 +136,7 @@ (def: (= test subject) ("lux text =" subject test))) -(struct: #export _ (order;Order Text) +(struct: #export _ (order.Order Text) (def: eq Eq<Text>) (def: (< test subject) @@ -183,13 +183,13 @@ (def: #export concat (-> (List Text) Text) - (let [(^open) list;Fold<List> + (let [(^open) list.Fold<List> (^open) Monoid<Text>] - (|>> list;reverse (fold text/compose identity)))) + (|>> list.reverse (fold text/compose identity)))) (def: #export (join-with sep texts) (-> Text (List Text) Text) - (|> texts (list;interpose sep) concat)) + (|> texts (list.interpose sep) concat)) (def: #export (empty? text) (-> Text Bool) @@ -199,20 +199,20 @@ (def: #export (replace-once pattern value template) (-> Text Text Text Text) - (maybe;default template - (do maybe;Monad<Maybe> + (maybe.default template + (do maybe.Monad<Maybe> [[pre post] (split-with pattern template) #let [(^open) Monoid<Text>]] (wrap ($_ text/compose pre value post))))) (def: #export (enclose [left right] content) - {#;doc "Surrounds the given content text with left and right side additions."} + {#.doc "Surrounds the given content text with left and right side additions."} (-> [Text Text] Text Text) (let [(^open) Monoid<Text>] ($_ text/compose left content right))) (def: #export (enclose' boundary content) - {#;doc "Surrounds the given content text with the same boundary text."} + {#.doc "Surrounds the given content text with the same boundary text."} (-> Text Text Text) (enclose [boundary boundary] content)) @@ -221,7 +221,7 @@ ("lux nat char" code)) (def: #export (space? char) - {#;doc "Checks whether the character is white-space."} + {#.doc "Checks whether the character is white-space."} (-> Nat Bool) (case char (^or (^ (char "\t")) (^ (char "\v")) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 9f8d2b25f..e1c93bc5f 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] ["p" parser]) @@ -15,21 +15,22 @@ [macro] (macro [code] ["s" syntax #+ syntax: Syntax]) - (lang [type]))) + (lang [type]) + )) ## [Syntax] (def: #hidden _compose_ (-> Text Text Text) - (:: text;Monoid<Text> compose)) + (:: text.Monoid<Text> compose)) -(syntax: #export (format [fragments (p;many s;any)]) - {#;doc (doc "Text interpolation." +(syntax: #export (format [fragments (p.many s.any)]) + {#.doc (doc "Text interpolation." (format "Static part " (%t static) " does not match URI: " uri))} (wrap (list (` ($_ _compose_ (~@ fragments)))))) ## [Formatters] (type: #export (Formatter a) - {#;doc "A way to produce readable text from values."} + {#.doc "A way to produce readable text from values."} (-> a Text)) (do-template [<name> <type> <formatter>] @@ -37,31 +38,31 @@ (Formatter <type>) <formatter>)] - [%b Bool (:: bool;Codec<Text,Bool> encode)] - [%n Nat (:: number;Codec<Text,Nat> encode)] - [%i Int (:: number;Codec<Text,Int> encode)] - [%d Deg (:: number;Codec<Text,Deg> encode)] - [%f Frac (:: number;Codec<Text,Frac> encode)] - [%t Text text;encode] - [%ident Ident (:: ident;Codec<Text,Ident> encode)] - [%code Code code;to-text] - [%type Type type;to-text] - [%bin Nat (:: number;Binary@Codec<Text,Nat> encode)] - [%oct Nat (:: number;Octal@Codec<Text,Nat> encode)] - [%hex Nat (:: number;Hex@Codec<Text,Nat> encode)] - [%xml xml;XML (:: xml;Codec<Text,XML> encode)] - [%json json;JSON (:: json;Codec<Text,JSON> encode)] - [%instant instant;Instant (:: instant;Codec<Text,Instant> encode)] - [%duration duration;Duration (:: duration;Codec<Text,Duration> encode)] - [%date date;Date (:: date;Codec<Text,Date> encode)] + [%b Bool (:: bool.Codec<Text,Bool> encode)] + [%n Nat (:: number.Codec<Text,Nat> encode)] + [%i Int (:: number.Codec<Text,Int> encode)] + [%d Deg (:: number.Codec<Text,Deg> encode)] + [%f Frac (:: number.Codec<Text,Frac> encode)] + [%t Text text.encode] + [%ident Ident (:: ident.Codec<Text,Ident> encode)] + [%code Code code.to-text] + [%type Type type.to-text] + [%bin Nat (:: number.Binary@Codec<Text,Nat> encode)] + [%oct Nat (:: number.Octal@Codec<Text,Nat> encode)] + [%hex Nat (:: number.Hex@Codec<Text,Nat> encode)] + [%xml xml.XML (:: xml.Codec<Text,XML> encode)] + [%json json.JSON (:: json.Codec<Text,JSON> encode)] + [%instant instant.Instant (:: instant.Codec<Text,Instant> encode)] + [%duration duration.Duration (:: duration.Codec<Text,Duration> encode)] + [%date date.Date (:: date.Codec<Text,Date> encode)] ) (def: #export (%list formatter) (All [a] (-> (Formatter a) (Formatter (List a)))) (function [values] (case values - #;Nil + #.Nil "(list)" _ - (format "(list " (text;join-with " " (list/map formatter values)) ")")))) + (format "(list " (text.join-with " " (list/map formatter values)) ")")))) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 354dc29a9..320e28d6d 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -1,4 +1,4 @@ -(;module: +(.module: [lux #- not] (lux (control [monad #+ do Monad] ["p" parser]) @@ -14,11 +14,11 @@ (def: start-offset Offset +0) (type: #export Lexer - (p;Parser [Offset Text])) + (p.Parser [Offset Text])) (def: (remaining offset tape) (-> Offset Text Text) - (|> tape (text;split offset) maybe;assume product;right)) + (|> tape (text.split offset) maybe.assume product.right)) (def: cannot-lex-error Text "Cannot lex from empty text.") @@ -27,231 +27,231 @@ ($_ text/compose "Unconsumed input: " (remaining offset tape))) (def: #export (run input lexer) - (All [a] (-> Text (Lexer a) (E;Error a))) + (All [a] (-> Text (Lexer a) (E.Error a))) (case (lexer [start-offset input]) - (#E;Error msg) - (#E;Error msg) - - (#E;Success [[end-offset _] output]) - (if (n/= end-offset (text;size input)) - (#E;Success output) - (#E;Error (unconsumed-input-error end-offset input))) - )) + (#E.Error msg) + (#E.Error msg) + + (#E.Success [[end-offset _] output]) + (if (n/= end-offset (text.size input)) + (#E.Success output) + (#E.Error (unconsumed-input-error end-offset input))) + )) (def: #export any - {#;doc "Just returns the next character without applying any logic."} + {#.doc "Just returns the next character without applying any logic."} (Lexer Text) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (#E;Success [[(n/inc offset) tape] (text;from-code output)]) + (case (text.nth offset tape) + (#.Some output) + (#E.Success [[(n/inc offset) tape] (text.from-code output)]) - _ - (#E;Error cannot-lex-error)) - )) + _ + (#E.Error cannot-lex-error)) + )) (def: #export (not p) - {#;doc "Produce a character if the lexer fails."} + {#.doc "Produce a character if the lexer fails."} (All [a] (-> (Lexer a) (Lexer Text))) (function [input] - (case (p input) - (#E;Error msg) - (any input) - - _ - (#E;Error "Expected to fail; yet succeeded.")))) + (case (p input) + (#E.Error msg) + (any input) + + _ + (#E.Error "Expected to fail; yet succeeded.")))) (def: #export (this reference) - {#;doc "Lex a text if it matches the given sample."} + {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Unit)) (function [[offset tape]] - (case (text;index-of' reference offset tape) - (#;Some where) - (if (n/= offset where) - (#E;Success [[(n/+ (text;size reference) offset) tape] []]) - (#E;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " (maybe;assume (text;clip' offset tape))))) + (case (text.index-of' reference offset tape) + (#.Some where) + (if (n/= offset where) + (#E.Success [[(n/+ (text.size reference) offset) tape] []]) + (#E.Error ($_ text/compose "Could not match: " (text.encode reference) " @ " (maybe.assume (text.clip' offset tape))))) - _ - (#E;Error ($_ text/compose "Could not match: " (text;encode reference)))))) + _ + (#E.Error ($_ text/compose "Could not match: " (text.encode reference)))))) (def: #export (this? reference) - {#;doc "Lex a text if it matches the given sample."} + {#.doc "Lex a text if it matches the given sample."} (-> Text (Lexer Bool)) (function [(^@ input [offset tape])] - (case (text;index-of' reference offset tape) - (^multi (#;Some where) (n/= offset where)) - (#E;Success [[(n/+ (text;size reference) offset) tape] true]) + (case (text.index-of' reference offset tape) + (^multi (#.Some where) (n/= offset where)) + (#E.Success [[(n/+ (text.size reference) offset) tape] true]) - _ - (#E;Success [input false])))) + _ + (#E.Success [input false])))) (def: #export end - {#;doc "Ensure the lexer's input is empty."} + {#.doc "Ensure the lexer's input is empty."} (Lexer Unit) (function [(^@ input [offset tape])] - (if (n/= offset (text;size tape)) - (#E;Success [input []]) - (#E;Error (unconsumed-input-error offset tape))))) + (if (n/= offset (text.size tape)) + (#E.Success [input []]) + (#E.Error (unconsumed-input-error offset tape))))) (def: #export end? - {#;doc "Ask if the lexer's input is empty."} + {#.doc "Ask if the lexer's input is empty."} (Lexer Bool) (function [(^@ input [offset tape])] - (#E;Success [input (n/= offset (text;size tape))]))) + (#E.Success [input (n/= offset (text.size tape))]))) (def: #export peek - {#;doc "Lex the next character (without consuming it from the input)."} + {#.doc "Lex the next character (without consuming it from the input)."} (Lexer Text) (function [(^@ input [offset tape])] - (case (text;nth offset tape) - (#;Some output) - (#E;Success [input (text;from-code output)]) + (case (text.nth offset tape) + (#.Some output) + (#E.Success [input (text.from-code output)]) - _ - (#E;Error cannot-lex-error)) - )) + _ + (#E.Error cannot-lex-error)) + )) (def: #export get-input - {#;doc "Get all of the remaining input (without consuming it)."} + {#.doc "Get all of the remaining input (without consuming it)."} (Lexer Text) (function [(^@ input [offset tape])] - (#E;Success [input (remaining offset tape)]))) + (#E.Success [input (remaining offset tape)]))) (def: #export (range bottom top) - {#;doc "Only lex characters within a range."} + {#.doc "Only lex characters within a range."} (-> Nat Nat (Lexer Text)) - (do p;Monad<Parser> - [char any - #let [char' (maybe;assume (text;nth +0 char))] - _ (p;assert ($_ text/compose "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) - (and (n/>= bottom char') - (n/<= top char')))] - (wrap char))) + (do p.Monad<Parser> + [char any + #let [char' (maybe.assume (text.nth +0 char))] + _ (p.assert ($_ text/compose "Character is not within range: " (text.from-code bottom) "-" (text.from-code top)) + (and (n/>= bottom char') + (n/<= top char')))] + (wrap char))) (do-template [<name> <bottom> <top> <desc>] - [(def: #export <name> - {#;doc (code;text ($_ text/compose "Only lex " <desc> " characters."))} - (Lexer Text) - (range (char <bottom>) (char <top>)))] + [(def: #export <name> + {#.doc (code.text ($_ text/compose "Only lex " <desc> " characters."))} + (Lexer Text) + (range (char <bottom>) (char <top>)))] - [upper "A" "Z" "uppercase"] - [lower "a" "z" "lowercase"] - [decimal "0" "9" "decimal"] - [octal "0" "7" "octal"] - ) + [upper "A" "Z" "uppercase"] + [lower "a" "z" "lowercase"] + [decimal "0" "9" "decimal"] + [octal "0" "7" "octal"] + ) (def: #export alpha - {#;doc "Only lex alphabetic characters."} + {#.doc "Only lex alphabetic characters."} (Lexer Text) - (p;either lower upper)) + (p.either lower upper)) (def: #export alpha-num - {#;doc "Only lex alphanumeric characters."} + {#.doc "Only lex alphanumeric characters."} (Lexer Text) - (p;either alpha decimal)) + (p.either alpha decimal)) (def: #export hexadecimal - {#;doc "Only lex hexadecimal digits."} + {#.doc "Only lex hexadecimal digits."} (Lexer Text) - ($_ p;either + ($_ p.either decimal (range (char "a") (char "f")) (range (char "A") (char "F")))) (def: #export (one-of options) - {#;doc "Only lex characters that are part of a piece of text."} + {#.doc "Only lex characters that are part of a piece of text."} (-> Text (Lexer Text)) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (let [output (text;from-code output)] - (if (text;contains? output options) - (#E;Success [[(n/inc offset) tape] output]) - (#E;Error ($_ text/compose "Character (" output ") is not one of: " options)))) + (case (text.nth offset tape) + (#.Some output) + (let [output (text.from-code output)] + (if (text.contains? output options) + (#E.Success [[(n/inc offset) tape] output]) + (#E.Error ($_ text/compose "Character (" output ") is not one of: " options)))) - _ - (#E;Error cannot-lex-error)))) + _ + (#E.Error cannot-lex-error)))) (def: #export (none-of options) - {#;doc "Only lex characters that are not part of a piece of text."} + {#.doc "Only lex characters that are not part of a piece of text."} (-> Text (Lexer Text)) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (let [output (text;from-code output)] - (if (;not (text;contains? output options)) - (#E;Success [[(n/inc offset) tape] output]) - (#E;Error ($_ text/compose "Character (" output ") is one of: " options)))) + (case (text.nth offset tape) + (#.Some output) + (let [output (text.from-code output)] + (if (.not (text.contains? output options)) + (#E.Success [[(n/inc offset) tape] output]) + (#E.Error ($_ text/compose "Character (" output ") is one of: " options)))) - _ - (#E;Error cannot-lex-error)))) + _ + (#E.Error cannot-lex-error)))) (def: #export (satisfies p) - {#;doc "Only lex characters that satisfy a predicate."} + {#.doc "Only lex characters that satisfy a predicate."} (-> (-> Nat Bool) (Lexer Text)) (function [[offset tape]] - (case (text;nth offset tape) - (#;Some output) - (if (p output) - (#E;Success [[(n/inc offset) tape] (text;from-code output)]) - (#E;Error ($_ text/compose "Character does not satisfy predicate: " (text;from-code output)))) + (case (text.nth offset tape) + (#.Some output) + (if (p output) + (#E.Success [[(n/inc offset) tape] (text.from-code output)]) + (#E.Error ($_ text/compose "Character does not satisfy predicate: " (text.from-code output)))) - _ - (#E;Error cannot-lex-error)))) + _ + (#E.Error cannot-lex-error)))) (def: #export space - {#;doc "Only lex white-space."} + {#.doc "Only lex white-space."} (Lexer Text) - (satisfies text;space?)) + (satisfies text.space?)) (def: #export (seq left right) (-> (Lexer Text) (Lexer Text) (Lexer Text)) - (do p;Monad<Parser> - [=left left - =right right] - (wrap ($_ text/compose =left =right)))) + (do p.Monad<Parser> + [=left left + =right right] + (wrap ($_ text/compose =left =right)))) (do-template [<name> <base> <doc>] - [(def: #export (<name> p) - {#;doc <doc>} - (-> (Lexer Text) (Lexer Text)) - (|> p <base> (:: p;Monad<Parser> map text;concat)))] + [(def: #export (<name> p) + {#.doc <doc>} + (-> (Lexer Text) (Lexer Text)) + (|> p <base> (:: p.Monad<Parser> map text.concat)))] - [some p;some "Lex some characters as a single continuous text."] - [many p;many "Lex many characters as a single continuous text."] - ) + [some p.some "Lex some characters as a single continuous text."] + [many p.many "Lex many characters as a single continuous text."] + ) (do-template [<name> <base> <doc>] - [(def: #export (<name> n p) - {#;doc <doc>} - (-> Nat (Lexer Text) (Lexer Text)) - (do p;Monad<Parser> - [] - (|> p (<base> n) (:: @ map text;concat))))] - - [exactly p;exactly "Lex exactly N characters."] - [at-most p;at-most "Lex at most N characters."] - [at-least p;at-least "Lex at least N characters."] - ) + [(def: #export (<name> n p) + {#.doc <doc>} + (-> Nat (Lexer Text) (Lexer Text)) + (do p.Monad<Parser> + [] + (|> p (<base> n) (:: @ map text.concat))))] + + [exactly p.exactly "Lex exactly N characters."] + [at-most p.at-most "Lex at most N characters."] + [at-least p.at-least "Lex at least N characters."] + ) (def: #export (between from to p) - {#;doc "Lex between N and M characters."} + {#.doc "Lex between N and M characters."} (-> Nat Nat (Lexer Text) (Lexer Text)) - (|> p (p;between from to) (:: p;Monad<Parser> map text;concat))) + (|> p (p.between from to) (:: p.Monad<Parser> map text.concat))) (def: #export (enclosed [start end] lexer) (All [a] (-> [Text Text] (Lexer a) (Lexer a))) (|> lexer - (p;before (this end)) - (p;after (this start)))) + (p.before (this end)) + (p.after (this start)))) (def: #export (local local-input lexer) - {#;doc "Run a lexer with the given input, instead of the real one."} + {#.doc "Run a lexer with the given input, instead of the real one."} (All [a] (-> Text (Lexer a) (Lexer a))) (function [real-input] - (case (run local-input lexer) - (#E;Error error) - (#E;Error error) + (case (run local-input lexer) + (#E.Error error) + (#E.Error error) - (#E;Success value) - (#E;Success [real-input value])))) + (#E.Success value) + (#E.Success [real-input value])))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 4dccf7855..1f1a0a3c0 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control monad ["p" parser "p/" Monad<Parser>]) @@ -16,188 +16,188 @@ ## [Utils] (def: regex-char^ - (l;Lexer Text) - (l;none-of "\\.|&()[]{}")) + (l.Lexer Text) + (l.none-of "\\.|&()[]{}")) (def: escaped-char^ - (l;Lexer Text) - (do p;Monad<Parser> - [? (l;this? "\\")] + (l.Lexer Text) + (do p.Monad<Parser> + [? (l.this? "\\")] (if ? - l;any + l.any regex-char^))) (def: #hidden (refine^ refinement^ base^) - (All [a] (-> (l;Lexer a) (l;Lexer Text) (l;Lexer Text))) - (do p;Monad<Parser> + (All [a] (-> (l.Lexer a) (l.Lexer Text) (l.Lexer Text))) + (do p.Monad<Parser> [output base^ - _ (l;local output refinement^)] + _ (l.local output refinement^)] (wrap output))) (def: #hidden word^ - (l;Lexer Text) - (p;either l;alpha-num - (l;one-of "_"))) + (l.Lexer Text) + (p.either l.alpha-num + (l.one-of "_"))) (def: #hidden (copy reference) - (-> Text (l;Lexer Text)) - (p;after (l;this reference) (p/wrap reference))) + (-> Text (l.Lexer Text)) + (p.after (l.this reference) (p/wrap reference))) (def: #hidden (join-text^ part^) - (-> (l;Lexer (List Text)) (l;Lexer Text)) - (do p;Monad<Parser> + (-> (l.Lexer (List Text)) (l.Lexer Text)) + (do p.Monad<Parser> [parts part^] - (wrap (text;join-with "" parts)))) + (wrap (text.join-with "" parts)))) (def: identifier-char^ - (l;Lexer Text) - (l;none-of "[]{}()s\"#;<>")) + (l.Lexer Text) + (l.none-of "[]{}()s\"#.<>")) (def: identifier-part^ - (l;Lexer Text) - (do p;Monad<Parser> - [head (refine^ (l;not l;decimal) + (l.Lexer Text) + (do p.Monad<Parser> + [head (refine^ (l.not l.decimal) identifier-char^) - tail (l;some identifier-char^)] + tail (l.some identifier-char^)] (wrap (format head tail)))) (def: (identifier^ current-module) - (-> Text (l;Lexer Ident)) - ($_ p;either - (p;seq (p/wrap current-module) (p;after (l;this ";;") identifier-part^)) - (p;seq identifier-part^ (p;after (l;this ";") identifier-part^)) - (p;seq (p/wrap "lux") (p;after (l;this ";") identifier-part^)) - (p;seq (p/wrap "") identifier-part^))) + (-> Text (l.Lexer Ident)) + ($_ p.either + (p.seq (p/wrap current-module) (p.after (l.this "..") identifier-part^)) + (p.seq identifier-part^ (p.after (l.this ".") identifier-part^)) + (p.seq (p/wrap "lux") (p.after (l.this ".") identifier-part^)) + (p.seq (p/wrap "") identifier-part^))) (def: (re-var^ current-module) - (-> Text (l;Lexer Code)) - (do p;Monad<Parser> - [ident (l;enclosed ["\\@<" ">"] (identifier^ current-module))] - (wrap (` (: (l;Lexer Text) (~ (code;symbol ident))))))) + (-> Text (l.Lexer Code)) + (do p.Monad<Parser> + [ident (l.enclosed ["\\@<" ">"] (identifier^ current-module))] + (wrap (` (: (l.Lexer Text) (~ (code.symbol ident))))))) (def: re-range^ - (l;Lexer Code) - (do p;Monad<Parser> - [from (|> regex-char^ (:: @ map (|>> (text;nth +0) maybe;assume))) - _ (l;this "-") - to (|> regex-char^ (:: @ map (|>> (text;nth +0) maybe;assume)))] - (wrap (` (l;range (~ (code;nat from)) (~ (code;nat to))))))) + (l.Lexer Code) + (do p.Monad<Parser> + [from (|> regex-char^ (:: @ map (|>> (text.nth +0) maybe.assume))) + _ (l.this "-") + to (|> regex-char^ (:: @ map (|>> (text.nth +0) maybe.assume)))] + (wrap (` (l.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re-char^ - (l;Lexer Code) - (do p;Monad<Parser> + (l.Lexer Code) + (do p.Monad<Parser> [char escaped-char^] - (wrap (` (;;copy (~ (code;text char))))))) + (wrap (` (..copy (~ (code.text char))))))) (def: re-options^ - (l;Lexer Code) - (do p;Monad<Parser> - [options (l;many escaped-char^)] - (wrap (` (l;one-of (~ (code;text options))))))) + (l.Lexer Code) + (do p.Monad<Parser> + [options (l.many escaped-char^)] + (wrap (` (l.one-of (~ (code.text options))))))) (def: re-user-class^' - (l;Lexer Code) - (do p;Monad<Parser> - [negate? (p;maybe (l;this "^")) - parts (p;many ($_ p;either + (l.Lexer Code) + (do p.Monad<Parser> + [negate? (p.maybe (l.this "^")) + parts (p.many ($_ p.either re-range^ re-options^))] (wrap (case negate? - (#;Some _) (` (l;not ($_ p;either (~@ parts)))) - #;None (` ($_ p;either (~@ parts))))))) + (#.Some _) (` (l.not ($_ p.either (~@ parts)))) + #.None (` ($_ p.either (~@ parts))))))) (def: re-user-class^ - (l;Lexer Code) - (do p;Monad<Parser> + (l.Lexer Code) + (do p.Monad<Parser> [_ (wrap []) init re-user-class^' - rest (p;some (p;after (l;this "&&") (l;enclosed ["[" "]"] re-user-class^')))] + rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))] (wrap (list/fold (function [refinement base] (` (refine^ (~ refinement) (~ base)))) init rest)))) (def: #hidden blank^ - (l;Lexer Text) - (l;one-of " \t")) + (l.Lexer Text) + (l.one-of " \t")) (def: #hidden ascii^ - (l;Lexer Text) - (l;range (char "\u0000") (char "\u007F"))) + (l.Lexer Text) + (l.range (char "\u0000") (char "\u007F"))) (def: #hidden control^ - (l;Lexer Text) - (p;either (l;range (char "\u0000") (char "\u001F")) - (l;one-of "\u007F"))) + (l.Lexer Text) + (p.either (l.range (char "\u0000") (char "\u001F")) + (l.one-of "\u007F"))) (def: #hidden punct^ - (l;Lexer Text) - (l;one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) + (l.Lexer Text) + (l.one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")) (def: #hidden graph^ - (l;Lexer Text) - (p;either punct^ l;alpha-num)) + (l.Lexer Text) + (p.either punct^ l.alpha-num)) (def: #hidden print^ - (l;Lexer Text) - (p;either graph^ - (l;one-of "\u0020"))) + (l.Lexer Text) + (p.either graph^ + (l.one-of "\u0020"))) (def: re-system-class^ - (l;Lexer Code) - (do p;Monad<Parser> + (l.Lexer Code) + (do p.Monad<Parser> [] - ($_ p;either - (p;after (l;this ".") (wrap (` l;any))) - (p;after (l;this "\\d") (wrap (` l;decimal))) - (p;after (l;this "\\D") (wrap (` (l;not l;decimal)))) - (p;after (l;this "\\s") (wrap (` l;space))) - (p;after (l;this "\\S") (wrap (` (l;not l;space)))) - (p;after (l;this "\\w") (wrap (` word^))) - (p;after (l;this "\\W") (wrap (` (l;not word^)))) - - (p;after (l;this "\\p{Lower}") (wrap (` l;lower))) - (p;after (l;this "\\p{Upper}") (wrap (` l;upper))) - (p;after (l;this "\\p{Alpha}") (wrap (` l;alpha))) - (p;after (l;this "\\p{Digit}") (wrap (` l;decimal))) - (p;after (l;this "\\p{Alnum}") (wrap (` l;alpha-num))) - (p;after (l;this "\\p{Space}") (wrap (` l;space))) - (p;after (l;this "\\p{HexDigit}") (wrap (` l;hexadecimal))) - (p;after (l;this "\\p{OctDigit}") (wrap (` l;octal))) - (p;after (l;this "\\p{Blank}") (wrap (` blank^))) - (p;after (l;this "\\p{ASCII}") (wrap (` ascii^))) - (p;after (l;this "\\p{Contrl}") (wrap (` control^))) - (p;after (l;this "\\p{Punct}") (wrap (` punct^))) - (p;after (l;this "\\p{Graph}") (wrap (` graph^))) - (p;after (l;this "\\p{Print}") (wrap (` print^))) + ($_ p.either + (p.after (l.this ".") (wrap (` l.any))) + (p.after (l.this "\\d") (wrap (` l.decimal))) + (p.after (l.this "\\D") (wrap (` (l.not l.decimal)))) + (p.after (l.this "\\s") (wrap (` l.space))) + (p.after (l.this "\\S") (wrap (` (l.not l.space)))) + (p.after (l.this "\\w") (wrap (` word^))) + (p.after (l.this "\\W") (wrap (` (l.not word^)))) + + (p.after (l.this "\\p{Lower}") (wrap (` l.lower))) + (p.after (l.this "\\p{Upper}") (wrap (` l.upper))) + (p.after (l.this "\\p{Alpha}") (wrap (` l.alpha))) + (p.after (l.this "\\p{Digit}") (wrap (` l.decimal))) + (p.after (l.this "\\p{Alnum}") (wrap (` l.alpha-num))) + (p.after (l.this "\\p{Space}") (wrap (` l.space))) + (p.after (l.this "\\p{HexDigit}") (wrap (` l.hexadecimal))) + (p.after (l.this "\\p{OctDigit}") (wrap (` l.octal))) + (p.after (l.this "\\p{Blank}") (wrap (` blank^))) + (p.after (l.this "\\p{ASCII}") (wrap (` ascii^))) + (p.after (l.this "\\p{Contrl}") (wrap (` control^))) + (p.after (l.this "\\p{Punct}") (wrap (` punct^))) + (p.after (l.this "\\p{Graph}") (wrap (` graph^))) + (p.after (l.this "\\p{Print}") (wrap (` print^))) ))) (def: re-class^ - (l;Lexer Code) - (p;either re-system-class^ - (l;enclosed ["[" "]"] re-user-class^))) + (l.Lexer Code) + (p.either re-system-class^ + (l.enclosed ["[" "]"] re-user-class^))) (def: number^ - (l;Lexer Nat) - (|> (l;many l;decimal) - (p;codec number;Codec<Text,Int>) + (l.Lexer Nat) + (|> (l.many l.decimal) + (p.codec number.Codec<Text,Int>) (p/map int-to-nat))) (def: re-back-reference^ - (l;Lexer Code) - (p;either (do p;Monad<Parser> - [_ (l;this "\\") + (l.Lexer Code) + (p.either (do p.Monad<Parser> + [_ (l.this "\\") id number^] - (wrap (` (;;copy (~ (code;symbol ["" (int/encode (nat-to-int id))])))))) - (do p;Monad<Parser> - [_ (l;this "\\k<") + (wrap (` (..copy (~ (code.symbol ["" (int/encode (nat-to-int id))])))))) + (do p.Monad<Parser> + [_ (l.this "\\k<") captured-name identifier-part^ - _ (l;this ">")] - (wrap (` (;;copy (~ (code;symbol ["" captured-name])))))))) + _ (l.this ">")] + (wrap (` (..copy (~ (code.symbol ["" captured-name])))))))) (def: (re-simple^ current-module) - (-> Text (l;Lexer Code)) - ($_ p;either + (-> Text (l.Lexer Code)) + ($_ p.either re-class^ (re-var^ current-module) re-back-reference^ @@ -205,57 +205,57 @@ )) (def: (re-simple-quantified^ current-module) - (-> Text (l;Lexer Code)) - (do p;Monad<Parser> + (-> Text (l.Lexer Code)) + (do p.Monad<Parser> [base (re-simple^ current-module) - quantifier (l;one-of "?*+")] + quantifier (l.one-of "?*+")] (case quantifier "?" - (wrap (` (p;default "" (~ base)))) + (wrap (` (p.default "" (~ base)))) "*" - (wrap (` (join-text^ (p;some (~ base))))) + (wrap (` (join-text^ (p.some (~ base))))) ## "+" _ - (wrap (` (join-text^ (p;many (~ base))))) + (wrap (` (join-text^ (p.many (~ base))))) ))) (def: (re-counted-quantified^ current-module) - (-> Text (l;Lexer Code)) - (do p;Monad<Parser> + (-> Text (l.Lexer Code)) + (do p.Monad<Parser> [base (re-simple^ current-module)] - (l;enclosed ["{" "}"] - ($_ p;either + (l.enclosed ["{" "}"] + ($_ p.either (do @ - [[from to] (p;seq number^ (p;after (l;this ",") number^))] - (wrap (` (join-text^ (p;between (~ (code;nat from)) - (~ (code;nat to)) + [[from to] (p.seq number^ (p.after (l.this ",") number^))] + (wrap (` (join-text^ (p.between (~ (code.nat from)) + (~ (code.nat to)) (~ base)))))) (do @ - [limit (p;after (l;this ",") number^)] - (wrap (` (join-text^ (p;at-most (~ (code;nat limit)) (~ base)))))) + [limit (p.after (l.this ",") number^)] + (wrap (` (join-text^ (p.at-most (~ (code.nat limit)) (~ base)))))) (do @ - [limit (p;before (l;this ",") number^)] - (wrap (` (join-text^ (p;at-least (~ (code;nat limit)) (~ base)))))) + [limit (p.before (l.this ",") number^)] + (wrap (` (join-text^ (p.at-least (~ (code.nat limit)) (~ base)))))) (do @ [limit number^] - (wrap (` (join-text^ (p;exactly (~ (code;nat limit)) (~ base)))))))))) + (wrap (` (join-text^ (p.exactly (~ (code.nat limit)) (~ base)))))))))) (def: (re-quantified^ current-module) - (-> Text (l;Lexer Code)) - (p;either (re-simple-quantified^ current-module) + (-> Text (l.Lexer Code)) + (p.either (re-simple-quantified^ current-module) (re-counted-quantified^ current-module))) (def: (re-complex^ current-module) - (-> Text (l;Lexer Code)) - ($_ p;either + (-> Text (l.Lexer Code)) + ($_ p.either (re-quantified^ current-module) (re-simple^ current-module))) (def: #hidden _text/compose_ (-> Text Text Text) - (:: text;Monoid<Text> compose)) + (:: text.Monoid<Text> compose)) (type: Re-Group #Non-Capturing @@ -263,35 +263,35 @@ (def: (re-sequential^ capturing? re-scoped^ current-module) (-> Bool - (-> Text (l;Lexer [Re-Group Code])) + (-> Text (l.Lexer [Re-Group Code])) Text - (l;Lexer [Nat Code])) - (do p;Monad<Parser> - [parts (p;many (p;alt (re-complex^ current-module) + (l.Lexer [Nat Code])) + (do p.Monad<Parser> + [parts (p.many (p.alt (re-complex^ current-module) (re-scoped^ current-module))) - #let [g!total (code;symbol ["" "0total"]) - g!temp (code;symbol ["" "0temp"]) + #let [g!total (code.symbol ["" "0total"]) + g!temp (code.symbol ["" "0temp"]) [_ names steps] (list/fold (: (-> (Either Code [Re-Group Code]) [Int (List Code) (List (List Code))] [Int (List Code) (List (List Code))]) (function [part [idx names steps]] (case part - (^or (#e;Error complex) (#e;Success [#Non-Capturing complex])) + (^or (#e.Error complex) (#e.Success [#Non-Capturing complex])) [idx names (list& (list g!temp complex (' #let) (` [(~ g!total) (_text/compose_ (~ g!total) (~ g!temp))])) steps)] - (#e;Success [(#Capturing [?name num-captures]) scoped]) + (#e.Success [(#Capturing [?name num-captures]) scoped]) (let [[idx! name!] (case ?name - (#;Some _name) - [idx (code;symbol ["" _name])] + (#.Some _name) + [idx (code.symbol ["" _name])] - #;None - [(i/inc idx) (code;symbol ["" (int/encode idx)])]) + #.None + [(i/inc idx) (code.symbol ["" (int/encode idx)])]) access (if (n/> +0 num-captures) - (` (product;left (~ name!))) + (` (product.left (~ name!))) name!)] [idx! (list& name! names) @@ -304,47 +304,47 @@ (: (List (List Code)) (list))] parts)]] (wrap [(if capturing? - (list;size names) + (list.size names) +0) - (` (do p;Monad<Parser> + (` (do p.Monad<Parser> [(~ (' #let)) [(~ g!total) ""] - (~@ (|> steps list;reverse list/join))] - ((~ (' wrap)) [(~ g!total) (~@ (list;reverse names))])))]) + (~@ (|> steps list.reverse list/join))] + ((~ (' wrap)) [(~ g!total) (~@ (list.reverse names))])))]) )) (def: #hidden (unflatten^ lexer) - (-> (l;Lexer Text) (l;Lexer [Text Unit])) - (p;seq lexer (:: p;Monad<Parser> wrap []))) + (-> (l.Lexer Text) (l.Lexer [Text Unit])) + (p.seq lexer (:: p.Monad<Parser> wrap []))) (def: #hidden (|||^ left right) - (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer [Text (| l r)]))) + (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer [Text (| l r)]))) (function [input] (case (left input) - (#e;Success [input' [lt lv]]) - (#e;Success [input' [lt (+0 lv)]]) + (#e.Success [input' [lt lv]]) + (#e.Success [input' [lt (+0 lv)]]) - (#e;Error _) + (#e.Error _) (case (right input) - (#e;Success [input' [rt rv]]) - (#e;Success [input' [rt (+1 rv)]]) + (#e.Success [input' [rt rv]]) + (#e.Success [input' [rt (+1 rv)]]) - (#e;Error error) - (#e;Error error))))) + (#e.Error error) + (#e.Error error))))) (def: #hidden (|||_^ left right) - (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer Text))) + (All [l r] (-> (l.Lexer [Text l]) (l.Lexer [Text r]) (l.Lexer Text))) (function [input] (case (left input) - (#e;Success [input' [lt lv]]) - (#e;Success [input' lt]) + (#e.Success [input' [lt lv]]) + (#e.Success [input' lt]) - (#e;Error _) + (#e.Error _) (case (right input) - (#e;Success [input' [rt rv]]) - (#e;Success [input' rt]) + (#e.Success [input' [rt rv]]) + (#e.Success [input' rt]) - (#e;Error error) - (#e;Error error))))) + (#e.Error error) + (#e.Error error))))) (def: (prep-alternative [num-captures alt]) (-> [Nat Code] Code) @@ -354,52 +354,52 @@ (def: (re-alternative^ capturing? re-scoped^ current-module) (-> Bool - (-> Text (l;Lexer [Re-Group Code])) + (-> Text (l.Lexer [Re-Group Code])) Text - (l;Lexer [Nat Code])) - (do p;Monad<Parser> + (l.Lexer [Nat Code])) + (do p.Monad<Parser> [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ - tail (p;some (p;after (l;this "|") sub^)) + tail (p.some (p.after (l.this "|") sub^)) #let [g!op (if capturing? (` |||^) (` |||_^))]] - (if (list;empty? tail) + (if (list.empty? tail) (wrap head) - (wrap [(list/fold n/max (product;left head) (list/map product;left tail)) + (wrap [(list/fold n/max (product.left head) (list/map product.left tail)) (` ($_ (~ g!op) (~ (prep-alternative head)) (~@ (list/map prep-alternative tail))))])))) (def: (re-scoped^ current-module) - (-> Text (l;Lexer [Re-Group Code])) - ($_ p;either - (do p;Monad<Parser> - [_ (l;this "(?:") + (-> Text (l.Lexer [Re-Group Code])) + ($_ p.either + (do p.Monad<Parser> + [_ (l.this "(?:") [_ scoped] (re-alternative^ false re-scoped^ current-module) - _ (l;this ")")] + _ (l.this ")")] (wrap [#Non-Capturing scoped])) - (do p;Monad<Parser> + (do p.Monad<Parser> [complex (re-complex^ current-module)] (wrap [#Non-Capturing complex])) - (do p;Monad<Parser> - [_ (l;this "(?<") + (do p.Monad<Parser> + [_ (l.this "(?<") captured-name identifier-part^ - _ (l;this ">") + _ (l.this ">") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (l;this ")")] - (wrap [(#Capturing [(#;Some captured-name) num-captures]) pattern])) - (do p;Monad<Parser> - [_ (l;this "(") + _ (l.this ")")] + (wrap [(#Capturing [(#.Some captured-name) num-captures]) pattern])) + (do p.Monad<Parser> + [_ (l.this "(") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (l;this ")")] - (wrap [(#Capturing [#;None num-captures]) pattern])))) + _ (l.this ")")] + (wrap [(#Capturing [#.None num-captures]) pattern])))) (def: (regex^ current-module) - (-> Text (l;Lexer Code)) - (:: p;Monad<Parser> map product;right (re-alternative^ true re-scoped^ current-module))) + (-> Text (l.Lexer Code)) + (:: p.Monad<Parser> map product.right (re-alternative^ true re-scoped^ current-module))) ## [Syntax] -(syntax: #export (regex [pattern s;text]) - {#;doc (doc "Create lexers using regular-expression syntax." +(syntax: #export (regex [pattern s.text]) + {#.doc (doc "Create lexers using regular-expression syntax." "For example:" "Literals" @@ -458,22 +458,22 @@ (regex "a(.)(.)|b(.)(.)") )} (do @ - [current-module macro;current-module-name] + [current-module macro.current-module-name] (case (|> (regex^ current-module) - (p;before l;end) - (l;run pattern)) - (#e;Error error) - (macro;fail (format "Error while parsing regular-expression:\n" + (p.before l.end) + (l.run pattern)) + (#e.Error error) + (macro.fail (format "Error while parsing regular-expression:\n" error)) - (#e;Success regex) + (#e.Success regex) (wrap (list regex)) ))) -(syntax: #export (^regex [[pattern bindings] (s;form (p;seq s;text (p;maybe s;any)))] +(syntax: #export (^regex [[pattern bindings] (s.form (p.seq s.text (p.maybe s.any)))] body - [branches (p;many s;any)]) - {#;doc (doc "Allows you to test text against regular expressions." + [branches (p.many s.any)]) + {#.doc (doc "Allows you to test text against regular expressions." (case some-text (^regex "(\\d{3})-(\\d{3})-(\\d{4})" [_ country-code area-code place-code]) @@ -485,10 +485,10 @@ _ do-something-else))} (do @ - [g!temp (macro;gensym "temp")] + [g!temp (macro.gensym "temp")] (wrap (list& (` (^multi (~ g!temp) - [(l;run (~ g!temp) (regex (~ (code;text pattern)))) - (#e;Success (~ (maybe;default g!temp + [(l.run (~ g!temp) (regex (~ (code.text pattern)))) + (#e.Success (~ (maybe.default g!temp bindings)))])) body branches)))) diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux index d34ab0a0a..a0eee684d 100644 --- a/stdlib/source/lux/data/trace.lux +++ b/stdlib/source/lux/data/trace.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid] [functor #+ Functor] @@ -18,7 +18,7 @@ (def: (unwrap wa) ((get@ #trace wa) - (get@ [#monoid #monoid;identity] wa))) + (get@ [#monoid #monoid.identity] wa))) (def: (split wa) (let [monoid (get@ #monoid wa)] diff --git a/stdlib/source/lux/function.lux b/stdlib/source/lux/function.lux index a6df64891..2fe4d6c1f 100644 --- a/stdlib/source/lux/function.lux +++ b/stdlib/source/lux/function.lux @@ -1,24 +1,24 @@ -(;module: +(.module: lux (lux (control [monoid #+ Monoid]))) (def: #export (compose f g) - {#;doc "Function composition."} + {#.doc "Function composition."} (All [a b c] (-> (-> b c) (-> a b) (-> a c))) (|>> g f)) (def: #export (const c) - {#;doc "Create constant functions."} + {#.doc "Create constant functions."} (All [a b] (-> a (-> b a))) (function [_] c)) (def: #export (flip f) - {#;doc "Flips the order of the arguments of a function."} + {#.doc "Flips the order of the arguments of a function."} (All [a b c] (-> (-> a b c) (-> b a c))) (function [x y] (f y x))) (struct: #export Monoid<Function> (Monoid (All [a] (-> a a))) (def: identity id) - (def: compose ;;compose)) + (def: compose ..compose)) diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index fdbc752c4..5e52cc283 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control monad ["p" parser]) @@ -9,7 +9,7 @@ )) (do-template [<name> <type>] - [(type: #export <name> (#;Primitive <type> #;Nil))] + [(type: #export <name> (#.Primitive <type> #.Nil))] [Object "object"] [Function "function"] @@ -27,24 +27,24 @@ ## [Syntax] (syntax: #export (set! field-name field-value object) - {#;doc (doc "A way to set fields from objects." + {#.doc (doc "A way to set fields from objects." (set! "foo" 1234 some-object))} (wrap (list (` ("js set-field" (~ object) (~ field-name) (~ field-value)))))) (syntax: #export (delete! field-name object) - {#;doc (doc "A way to delete fields from objects." + {#.doc (doc "A way to delete fields from objects." (delete! "foo" some-object))} (wrap (list (` ("js delete-field" (~ object) (~ field-name)))))) (syntax: #export (get field-name type object) - {#;doc (doc "A way to get fields from objects." + {#.doc (doc "A way to get fields from objects." (get "ceil" (ref "Math")) (get "ceil" (-> Frac Frac) (ref "Math")))} (wrap (list (` (:! (~ type) ("js get-field" (~ object) (~ field-name))))))) -(syntax: #export (object [kvs (p;some (p;seq s;any s;any))]) - {#;doc (doc "A way to create JavaScript objects." +(syntax: #export (object [kvs (p.some (p.seq s.any s.any))]) + {#.doc (doc "A way to create JavaScript objects." (object) (object "foo" foo "bar" (inc bar)))} (wrap (list (L/fold (function [[k v] object] @@ -52,16 +52,16 @@ (` ("js object")) kvs)))) -(syntax: #export (ref [name s;text] [type (p;maybe s;any)]) - {#;doc (doc "A way to refer to JavaScript variables." +(syntax: #export (ref [name s.text] [type (p.maybe s.any)]) + {#.doc (doc "A way to refer to JavaScript variables." (ref "document") (ref "Math.ceil" (-> Frac Frac)))} - (wrap (list (` (:! (~ (default (' ;;Object) type)) - ("js ref" (~ (code;text name)))))))) + (wrap (list (` (:! (~ (default (' ..Object) type)) + ("js ref" (~ (code.text name)))))))) (do-template [<name> <proc> <doc>] [(syntax: #export (<name>) - {#;doc (doc <doc> + {#.doc (doc <doc> (<name>))} (wrap (list (` (<proc>)))))] @@ -69,16 +69,16 @@ [undef "js undefined" "Undefined."] ) -(syntax: #export (call! [shape (p;alt ($_ p;seq s;any (s;tuple (p;some s;any)) (p;maybe s;any)) - ($_ p;seq s;any s;text (s;tuple (p;some s;any)) (p;maybe s;any)))]) - {#;doc (doc "A way to call JavaScript functions and methods." +(syntax: #export (call! [shape (p.alt ($_ p.seq s.any (s.tuple (p.some s.any)) (p.maybe s.any)) + ($_ p.seq s.any s.text (s.tuple (p.some s.any)) (p.maybe s.any)))]) + {#.doc (doc "A way to call JavaScript functions and methods." (call! (ref "Math.ceil") [123.45]) (call! (ref "Math") "ceil" [123.45]))} (case shape - (#;Left [function args ?type]) - (wrap (list (` (:! (~ (default (' ;;Object) ?type)) + (#.Left [function args ?type]) + (wrap (list (` (:! (~ (default (' ..Object) ?type)) ("js call" (~ function) (~@ args)))))) - (#;Right [object field args ?type]) - (wrap (list (` (:! (~ (default (' ;;Object) ?type)) - ("js object-call" (~ object) (~ (code;text field)) (~@ args)))))))) + (#.Right [object field args ?type]) + (wrap (list (` (:! (~ (default (' ..Object) ?type)) + ("js object-call" (~ object) (~ (code.text field)) (~@ args)))))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index de67b2a64..a53ec1a5f 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: [lux #- type] (lux (control [monad #+ do Monad] [enum] @@ -20,7 +20,7 @@ (do-template [<name> <op> <from> <to>] [(def: #export (<name> value) - {#;doc (doc "Type converter." + {#.doc (doc "Type converter." "From:" <from> "To:" @@ -225,11 +225,11 @@ ## Utils (def: (short-class-name name) (-> Text Text) - (case (list;reverse (text;split-all-with "/" name)) - (#;Cons short-name _) + (case (list.reverse (text.split-all-with "/" name)) + (#.Cons short-name _) short-name - #;Nil + #.Nil name)) (def: (manual-primitive-to-type class) @@ -237,7 +237,7 @@ (case class (^template [<prim> <type>] <prim> - (#;Some (' <type>))) + (#.Some (' <type>))) (["boolean" (primitive "java.lang.Boolean")] ["byte" (primitive "java.lang.Byte")] ["short" (primitive "java.lang.Short")] @@ -246,32 +246,32 @@ ["float" (primitive "java.lang.Float")] ["double" (primitive "java.lang.Double")] ["char" (primitive "java.lang.Character")] - ["void" ;Unit]) + ["void" .Unit]) _ - #;None)) + #.None)) (def: (auto-primitive-to-type class) (-> Text (Maybe Code)) (case class (^template [<prim> <type>] <prim> - (#;Some (' <type>))) - (["boolean" ;Bool] - ["byte" ;Int] - ["short" ;Int] - ["int" ;Int] - ["long" ;Int] - ["float" ;Frac] - ["double" ;Frac] - ["void" ;Unit]) + (#.Some (' <type>))) + (["boolean" .Bool] + ["byte" .Int] + ["short" .Int] + ["int" .Int] + ["long" .Int] + ["float" .Frac] + ["double" .Frac] + ["void" .Unit]) _ - #;None)) + #.None)) (def: sanitize (-> Text Text) - (text;replace-all "/" ".")) + (text.replace-all "/" ".")) (def: (generic-class->type' mode type-params in-array? name+params class->type') @@ -279,32 +279,32 @@ (-> Primitive-Mode (List TypeParam) Bool GenericType Code) Code) (case [name+params mode in-array?] - (^multi [[prim #;Nil] #ManualPrM false] - [(manual-primitive-to-type prim) (#;Some output)]) + (^multi [[prim #.Nil] #ManualPrM false] + [(manual-primitive-to-type prim) (#.Some output)]) output - (^multi [[prim #;Nil] #AutoPrM false] - [(auto-primitive-to-type prim) (#;Some output)]) + (^multi [[prim #.Nil] #AutoPrM false] + [(auto-primitive-to-type prim) (#.Some output)]) output [[name params] _ _] (let [name (sanitize name) =params (list/map (class->type' mode type-params in-array?) params)] - (` (primitive (~ (code;text name)) [(~@ =params)]))))) + (` (primitive (~ (code.text name)) [(~@ =params)]))))) (def: (class->type' mode type-params in-array? class) (-> Primitive-Mode (List TypeParam) Bool GenericType Code) (case class (#GenericTypeVar name) - (case (list;find (function [[pname pbounds]] + (case (list.find (function [[pname pbounds]] (and (text/= name pname) - (not (list;empty? pbounds)))) + (not (list.empty? pbounds)))) type-params) - #;None - (code;symbol ["" name]) + #.None + (code.symbol ["" name]) - (#;Some [pname pbounds]) - (class->type' mode type-params in-array? (maybe;assume (list;head pbounds)))) + (#.Some [pname pbounds]) + (class->type' mode type-params in-array? (maybe.assume (list.head pbounds)))) (#GenericClass name+params) (generic-class->type' mode type-params in-array? name+params @@ -312,12 +312,12 @@ (#GenericArray param) (let [=param (class->type' mode type-params true param)] - (` (;Array (~ =param)))) + (` (.Array (~ =param)))) - (^or (#GenericWildcard #;None) (#GenericWildcard (#;Some [#LowerBound _]))) - (' (;Ex [*] *)) + (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _]))) + (' (.Ex [*] *)) - (#GenericWildcard (#;Some [#UpperBound upper-bound])) + (#GenericWildcard (#.Some [#UpperBound upper-bound])) (class->type' mode type-params in-array? upper-bound) )) @@ -327,20 +327,20 @@ (def: (type-param-type$ [name bounds]) (-> TypeParam Code) - (code;symbol ["" name])) + (code.symbol ["" name])) (def: (class-decl-type$ (^slots [#class-name #class-params])) (-> ClassDecl Code) (let [=params (list/map (: (-> TypeParam Code) (function [[pname pbounds]] (case pbounds - #;Nil - (code;symbol ["" pname]) + #.Nil + (code.symbol ["" pname]) - (#;Cons bound1 _) + (#.Cons bound1 _) (class->type #ManualPrM class-params bound1)))) class-params)] - (` (primitive (~ (code;text (sanitize class-name))) + (` (primitive (~ (code.text (sanitize class-name))) [(~@ =params)])))) (def: empty-imports @@ -349,33 +349,33 @@ (def: (get-import name imports) (-> Text Class-Imports (Maybe Text)) - (:: maybe;Functor<Maybe> map product;right - (list;find (|>> product;left (text/= name)) + (:: maybe.Functor<Maybe> map product.right + (list.find (|>> product.left (text/= name)) imports))) (def: (add-import short+full imports) (-> [Text Text] Class-Imports Class-Imports) - (#;Cons short+full imports)) + (#.Cons short+full imports)) (def: (class-imports compiler) (-> Compiler Class-Imports) - (case (macro;run compiler + (case (macro.run compiler (: (Meta Class-Imports) (do Monad<Meta> - [current-module macro;current-module-name - defs (macro;defs current-module)] + [current-module macro.current-module-name + defs (macro.defs current-module)] (wrap (list/fold (: (-> [Text Def] Class-Imports Class-Imports) (function [[short-name [_ meta _]] imports] - (case (macro;get-text-ann (ident-for #;;jvm-class) meta) - (#;Some full-class-name) + (case (macro.get-text-ann (ident-for #..jvm-class) meta) + (#.Some full-class-name) (add-import [short-name full-class-name] imports) _ imports))) empty-imports defs))))) - (#;Left _) (list) - (#;Right imports) imports)) + (#.Left _) (list) + (#.Right imports) imports)) (def: java/lang/* (List Text) @@ -462,9 +462,9 @@ (def: (qualify imports name) (-> Class-Imports Text Text) - (if (list;member? text;Eq<Text> java/lang/* name) + (if (list.member? text.Eq<Text> java/lang/* name) (format "java/lang/" name) - (maybe;default name (get-import name imports)))) + (maybe.default name (get-import name imports)))) (def: type-var-class Text "java.lang.Object") @@ -472,20 +472,20 @@ (-> (List TypeParam) GenericType Text) (case class (#GenericTypeVar name) - (case (list;find (function [[pname pbounds]] + (case (list.find (function [[pname pbounds]] (and (text/= name pname) - (not (list;empty? pbounds)))) + (not (list.empty? pbounds)))) env) - #;None + #.None type-var-class - (#;Some [pname pbounds]) - (simple-class$ env (maybe;assume (list;head pbounds)))) + (#.Some [pname pbounds]) + (simple-class$ env (maybe.assume (list.head pbounds)))) - (^or (#GenericWildcard #;None) (#GenericWildcard (#;Some [#LowerBound _]))) + (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _]))) type-var-class - (#GenericWildcard (#;Some [#UpperBound upper-bound])) + (#GenericWildcard (#.Some [#UpperBound upper-bound])) (simple-class$ env upper-bound) (#GenericClass name env) @@ -497,7 +497,7 @@ (format "[" (simple-class$ env param)) (^template [<prim> <class>] - (#GenericClass <prim> #;Nil) + (#GenericClass <prim> #.Nil) <class>) (["boolean" "[Z"] ["byte" "[B"] @@ -514,25 +514,25 @@ (def: (make-get-const-parser class-name field-name) (-> Text Text (Syntax Code)) - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [dotted-name (format "::" field-name)] - _ (s;this (code;symbol ["" dotted-name]))] - (wrap (`' ((~ (code;text (format "jvm getstatic" ":" class-name ":" field-name)))))))) + _ (s.this (code.symbol ["" dotted-name]))] + (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class-name ":" field-name)))))))) (def: (make-get-var-parser class-name field-name) (-> Text Text (Syntax Code)) - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [dotted-name (format "::" field-name)] - _ (s;this (code;symbol ["" dotted-name]))] - (wrap (`' ((~ (code;text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this))))) + _ (s.this (code.symbol ["" dotted-name]))] + (wrap (`' ((~ (code.text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this))))) (def: (make-put-var-parser class-name field-name) (-> Text Text (Syntax Code)) - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [dotted-name (format "::" field-name)] [_ _ value] (: (Syntax [Unit Unit Code]) - (s;form ($_ p;seq (s;this (' :=)) (s;this (code;symbol ["" dotted-name])) s;any)))] - (wrap (`' ((~ (code;text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value)))))) + (s.form ($_ p.seq (s.this (' :=)) (s.this (code.symbol ["" dotted-name])) s.any)))] + (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value)))))) (def: (pre-walk-replace f input) (-> (-> Code Code) Code Code) @@ -540,11 +540,11 @@ (^template [<tag>] [meta (<tag> parts)] [meta (<tag> (list/map (pre-walk-replace f) parts))]) - ([#;Form] - [#;Tuple]) + ([#.Form] + [#.Tuple]) - [meta (#;Record pairs)] - [meta (#;Record (list/map (: (-> [Code Code] [Code Code]) + [meta (#.Record pairs)] + [meta (#.Record (list/map (: (-> [Code Code] [Code Code]) (function [[key val]] [(pre-walk-replace f key) (pre-walk-replace f val)])) pairs))] @@ -554,8 +554,8 @@ (def: (parser->replacer p ast) (-> (Syntax Code) (-> Code Code)) - (case (p;run (list ast) p) - (#;Right [#;Nil ast']) + (case (p.run (list ast) p) + (#.Right [#.Nil ast']) ast' _ @@ -569,37 +569,37 @@ (make-get-const-parser class-name field-name) (#VariableField _) - (p;either (make-get-var-parser class-name field-name) + (p.either (make-get-var-parser class-name field-name) (make-put-var-parser class-name field-name)))) (def: (make-constructor-parser params class-name arg-decls) (-> (List TypeParam) Text (List ArgDecl) (Syntax Code)) - (do p;Monad<Parser> + (do p.Monad<Parser> [[_ args] (: (Syntax [Unit (List Code)]) - (s;form ($_ p;seq (s;this (' ::new!)) (s;tuple (p;exactly (list;size arg-decls) s;any))))) - #let [arg-decls' (: (List Text) (list/map (|>> product;right (simple-class$ params)) arg-decls))]] - (wrap (` ((~ (code;text (format "jvm new" ":" class-name ":" (text;join-with "," arg-decls')))) + (s.form ($_ p.seq (s.this (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any))))) + #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] + (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls')))) (~@ args)))))) (def: (make-static-method-parser params class-name method-name arg-decls) (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [dotted-name (format "::" method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) - (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) - #let [arg-decls' (: (List Text) (list/map (|>> product;right (simple-class$ params)) arg-decls))]] - (wrap (`' ((~ (code;text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls')))) + (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) + #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] + (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~@ args)))))) (do-template [<name> <jvm-op>] [(def: (<name> params class-name method-name arg-decls) (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [dotted-name (format "::" method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) - (s;form ($_ p;seq (s;this (code;symbol ["" dotted-name])) (s;tuple (p;exactly (list;size arg-decls) s;any))))) - #let [arg-decls' (: (List Text) (list/map (|>> product;right (simple-class$ params)) arg-decls))]] - (wrap (`' ((~ (code;text (format <jvm-op> ":" class-name ":" method-name ":" (text;join-with "," arg-decls')))) + (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) + #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] + (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~' _jvm_this) (~@ args))))))] [make-special-method-parser "jvm invokespecial"] @@ -627,60 +627,60 @@ ## Syntaxs (def: (full-class-name^ imports) (-> Class-Imports (Syntax Text)) - (do p;Monad<Parser> - [name s;local-symbol] + (do p.Monad<Parser> + [name s.local-symbol] (wrap (qualify imports name)))) (def: privacy-modifier^ (Syntax PrivacyModifier) - (let [(^open) p;Monad<Parser>] - ($_ p;alt - (s;this (' #public)) - (s;this (' #private)) - (s;this (' #protected)) + (let [(^open) p.Monad<Parser>] + ($_ p.alt + (s.this (' #public)) + (s.this (' #private)) + (s.this (' #protected)) (wrap [])))) (def: inheritance-modifier^ (Syntax InheritanceModifier) - (let [(^open) p;Monad<Parser>] - ($_ p;alt - (s;this (' #final)) - (s;this (' #abstract)) + (let [(^open) p.Monad<Parser>] + ($_ p.alt + (s.this (' #final)) + (s.this (' #abstract)) (wrap [])))) (def: bound-kind^ (Syntax BoundKind) - (p;alt (s;this (' <)) - (s;this (' >)))) + (p.alt (s.this (' <)) + (s.this (' >)))) (def: (assert-no-periods name) (-> Text (Syntax Unit)) - (p;assert "Names in class declarations cannot contain periods." - (not (text;contains? "." name)))) + (p.assert "Names in class declarations cannot contain periods." + (not (text.contains? "." name)))) (def: (generic-type^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax GenericType)) - ($_ p;either - (do p;Monad<Parser> - [_ (s;this (' ?))] - (wrap (#GenericWildcard #;None))) - (s;tuple (do p;Monad<Parser> - [_ (s;this (' ?)) + ($_ p.either + (do p.Monad<Parser> + [_ (s.this (' ?))] + (wrap (#GenericWildcard #.None))) + (s.tuple (do p.Monad<Parser> + [_ (s.this (' ?)) bound-kind bound-kind^ bound (generic-type^ imports type-vars)] - (wrap (#GenericWildcard (#;Some [bound-kind bound]))))) - (do p;Monad<Parser> + (wrap (#GenericWildcard (#.Some [bound-kind bound]))))) + (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name)] - (if (list;member? text;Eq<Text> (list/map product;left type-vars) name) + (if (list.member? text.Eq<Text> (list/map product.left type-vars) name) (wrap (#GenericTypeVar name)) (wrap (#GenericClass name (list))))) - (s;form (do p;Monad<Parser> - [name (s;this (' Array)) + (s.form (do p.Monad<Parser> + [name (s.this (' Array)) component (generic-type^ imports type-vars)] (case component (^template [<class> <name>] - (#GenericClass <name> #;Nil) + (#GenericClass <name> #.Nil) (wrap (#GenericClass <class> (list)))) (["[Z" "boolean"] ["[B" "byte"] @@ -693,98 +693,98 @@ _ (wrap (#GenericArray component))))) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name) - params (p;some (generic-type^ imports type-vars)) - _ (p;assert (format name " cannot be a type-parameter!") - (not (list;member? text;Eq<Text> (list/map product;left type-vars) name)))] + params (p.some (generic-type^ imports type-vars)) + _ (p.assert (format name " cannot be a type-parameter!") + (not (list.member? text.Eq<Text> (list/map product.left type-vars) name)))] (wrap (#GenericClass name params)))) )) (def: (type-param^ imports) (-> Class-Imports (Syntax TypeParam)) - (p;either (do p;Monad<Parser> - [param-name s;local-symbol] + (p.either (do p.Monad<Parser> + [param-name s.local-symbol] (wrap [param-name (list)])) - (s;tuple (do p;Monad<Parser> - [param-name s;local-symbol - _ (s;this (' <)) - bounds (p;many (generic-type^ imports (list)))] + (s.tuple (do p.Monad<Parser> + [param-name s.local-symbol + _ (s.this (' <)) + bounds (p.many (generic-type^ imports (list)))] (wrap [param-name bounds]))))) (def: (type-params^ imports) (-> Class-Imports (Syntax (List TypeParam))) - (s;tuple (p;some (type-param^ imports)))) + (s.tuple (p.some (type-param^ imports)))) (def: (class-decl^ imports) (-> Class-Imports (Syntax ClassDecl)) - (p;either (do p;Monad<Parser> + (p.either (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name)] (wrap [name (list)])) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name) - params (p;some (type-param^ imports))] + params (p.some (type-param^ imports))] (wrap [name params]))) )) (def: (super-class-decl^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax Super-Class-Decl)) - (p;either (do p;Monad<Parser> + (p.either (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name)] (wrap [name (list)])) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name) - params (p;some (generic-type^ imports type-vars))] + params (p.some (generic-type^ imports type-vars))] (wrap [name params]))))) (def: annotation-params^ (Syntax (List AnnotationParam)) - (s;record (p;some (p;seq s;local-tag s;any)))) + (s.record (p.some (p.seq s.local-tag s.any)))) (def: (annotation^ imports) (-> Class-Imports (Syntax Annotation)) - (p;either (do p;Monad<Parser> + (p.either (do p.Monad<Parser> [ann-name (full-class-name^ imports)] (wrap [ann-name (list)])) - (s;form (p;seq (full-class-name^ imports) + (s.form (p.seq (full-class-name^ imports) annotation-params^)))) (def: (annotations^' imports) (-> Class-Imports (Syntax (List Annotation))) - (do p;Monad<Parser> - [_ (s;this (' #ann))] - (s;tuple (p;some (annotation^ imports))))) + (do p.Monad<Parser> + [_ (s.this (' #ann))] + (s.tuple (p.some (annotation^ imports))))) (def: (annotations^ imports) (-> Class-Imports (Syntax (List Annotation))) - (do p;Monad<Parser> - [anns?? (p;maybe (annotations^' imports))] - (wrap (maybe;default (list) anns??)))) + (do p.Monad<Parser> + [anns?? (p.maybe (annotations^' imports))] + (wrap (maybe.default (list) anns??)))) (def: (throws-decl'^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax (List GenericType))) - (do p;Monad<Parser> - [_ (s;this (' #throws))] - (s;tuple (p;some (generic-type^ imports type-vars))))) + (do p.Monad<Parser> + [_ (s.this (' #throws))] + (s.tuple (p.some (generic-type^ imports type-vars))))) (def: (throws-decl^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax (List GenericType))) - (do p;Monad<Parser> - [exs? (p;maybe (throws-decl'^ imports type-vars))] - (wrap (maybe;default (list) exs?)))) + (do p.Monad<Parser> + [exs? (p.maybe (throws-decl'^ imports type-vars))] + (wrap (maybe.default (list) exs?)))) (def: (method-decl^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDecl])) - (s;form (do p;Monad<Parser> - [tvars (p;default (list) (type-params^ imports)) - name s;local-symbol + (s.form (do p.Monad<Parser> + [tvars (p.default (list) (type-params^ imports)) + name s.local-symbol anns (annotations^ imports) - inputs (s;tuple (p;some (generic-type^ imports type-vars))) + inputs (s.tuple (p.some (generic-type^ imports type-vars))) output (generic-type^ imports type-vars) exs (throws-decl^ imports type-vars)] (wrap [[name #PublicPM anns] {#method-tvars tvars @@ -794,58 +794,58 @@ (def: state-modifier^ (Syntax StateModifier) - ($_ p;alt - (s;this (' #volatile)) - (s;this (' #final)) - (:: p;Monad<Parser> wrap []))) + ($_ p.alt + (s.this (' #volatile)) + (s.this (' #final)) + (:: p.Monad<Parser> wrap []))) (def: (field-decl^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax [MemberDecl FieldDecl])) - (p;either (s;form (do p;Monad<Parser> - [_ (s;this (' #const)) - name s;local-symbol + (p.either (s.form (do p.Monad<Parser> + [_ (s.this (' #const)) + name s.local-symbol anns (annotations^ imports) type (generic-type^ imports type-vars) - body s;any] + body s.any] (wrap [[name #PublicPM anns] (#ConstantField [type body])]))) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [pm privacy-modifier^ sm state-modifier^ - name s;local-symbol + name s.local-symbol anns (annotations^ imports) type (generic-type^ imports type-vars)] (wrap [[name pm anns] (#VariableField [sm type])]))))) (def: (arg-decl^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax ArgDecl)) - (s;tuple (p;seq s;local-symbol + (s.tuple (p.seq s.local-symbol (generic-type^ imports type-vars)))) (def: (arg-decls^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax (List ArgDecl))) - (p;some (arg-decl^ imports type-vars))) + (p.some (arg-decl^ imports type-vars))) (def: (constructor-arg^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax ConstructorArg)) - (s;tuple (p;seq (generic-type^ imports type-vars) s;any))) + (s.tuple (p.seq (generic-type^ imports type-vars) s.any))) (def: (constructor-args^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax (List ConstructorArg))) - (s;tuple (p;some (constructor-arg^ imports type-vars)))) + (s.tuple (p.some (constructor-arg^ imports type-vars)))) (def: (constructor-method^ imports class-vars) (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDef])) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [pm privacy-modifier^ - strict-fp? (s;this? (' #strict)) - method-vars (p;default (list) (type-params^ imports)) + strict-fp? (s.this? (' #strict)) + method-vars (p.default (list) (type-params^ imports)) #let [total-vars (list/compose class-vars method-vars)] - [_ arg-decls] (s;form (p;seq (s;this (' new)) + [_ arg-decls] (s.form (p.seq (s.this (' new)) (arg-decls^ imports total-vars))) constructor-args (constructor-args^ imports total-vars) exs (throws-decl^ imports total-vars) annotations (annotations^ imports) - body s;any] + body s.any] (wrap [{#member-name constructor-method-name #member-privacy pm #member-anns annotations} @@ -853,18 +853,18 @@ (def: (virtual-method-def^ imports class-vars) (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDef])) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [pm privacy-modifier^ - strict-fp? (s;this? (' #strict)) - final? (s;this? (' #final)) - method-vars (p;default (list) (type-params^ imports)) + strict-fp? (s.this? (' #strict)) + final? (s.this? (' #final)) + method-vars (p.default (list) (type-params^ imports)) #let [total-vars (list/compose class-vars method-vars)] - [name arg-decls] (s;form (p;seq s;local-symbol + [name arg-decls] (s.form (p.seq s.local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) exs (throws-decl^ imports total-vars) annotations (annotations^ imports) - body s;any] + body s.any] (wrap [{#member-name name #member-privacy pm #member-anns annotations} @@ -872,17 +872,17 @@ (def: (overriden-method-def^ imports) (-> Class-Imports (Syntax [MemberDecl MethodDef])) - (s;form (do p;Monad<Parser> - [strict-fp? (s;this? (' #strict)) + (s.form (do p.Monad<Parser> + [strict-fp? (s.this? (' #strict)) owner-class (class-decl^ imports) - method-vars (p;default (list) (type-params^ imports)) - #let [total-vars (list/compose (product;right owner-class) method-vars)] - [name arg-decls] (s;form (p;seq s;local-symbol + method-vars (p.default (list) (type-params^ imports)) + #let [total-vars (list/compose (product.right owner-class) method-vars)] + [name arg-decls] (s.form (p.seq s.local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) exs (throws-decl^ imports total-vars) annotations (annotations^ imports) - body s;any] + body s.any] (wrap [{#member-name name #member-privacy #PublicPM #member-anns annotations} @@ -890,18 +890,18 @@ (def: (static-method-def^ imports) (-> Class-Imports (Syntax [MemberDecl MethodDef])) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [pm privacy-modifier^ - strict-fp? (s;this? (' #strict)) - _ (s;this (' #static)) - method-vars (p;default (list) (type-params^ imports)) + strict-fp? (s.this? (' #strict)) + _ (s.this (' #static)) + method-vars (p.default (list) (type-params^ imports)) #let [total-vars method-vars] - [name arg-decls] (s;form (p;seq s;local-symbol + [name arg-decls] (s.form (p.seq s.local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) exs (throws-decl^ imports total-vars) annotations (annotations^ imports) - body s;any] + body s.any] (wrap [{#member-name name #member-privacy pm #member-anns annotations} @@ -909,12 +909,12 @@ (def: (abstract-method-def^ imports) (-> Class-Imports (Syntax [MemberDecl MethodDef])) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [pm privacy-modifier^ - _ (s;this (' #abstract)) - method-vars (p;default (list) (type-params^ imports)) + _ (s.this (' #abstract)) + method-vars (p.default (list) (type-params^ imports)) #let [total-vars method-vars] - [name arg-decls] (s;form (p;seq s;local-symbol + [name arg-decls] (s.form (p.seq s.local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) exs (throws-decl^ imports total-vars) @@ -926,12 +926,12 @@ (def: (native-method-def^ imports) (-> Class-Imports (Syntax [MemberDecl MethodDef])) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [pm privacy-modifier^ - _ (s;this (' #native)) - method-vars (p;default (list) (type-params^ imports)) + _ (s.this (' #native)) + method-vars (p.default (list) (type-params^ imports)) #let [total-vars method-vars] - [name arg-decls] (s;form (p;seq s;local-symbol + [name arg-decls] (s.form (p.seq s.local-symbol (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) exs (throws-decl^ imports total-vars) @@ -943,7 +943,7 @@ (def: (method-def^ imports class-vars) (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDef])) - ($_ p;either + ($_ p.either (constructor-method^ imports class-vars) (virtual-method-def^ imports class-vars) (overriden-method-def^ imports) @@ -953,54 +953,54 @@ (def: partial-call^ (Syntax Partial-Call) - (s;form (p;seq s;any s;any))) + (s.form (p.seq s.any s.any))) (def: class-kind^ (Syntax ClassKind) - (p;either (do p;Monad<Parser> - [_ (s;this (' #class))] + (p.either (do p.Monad<Parser> + [_ (s.this (' #class))] (wrap #Class)) - (do p;Monad<Parser> - [_ (s;this (' #interface))] + (do p.Monad<Parser> + [_ (s.this (' #interface))] (wrap #Interface)) )) (def: import-member-alias^ (Syntax (Maybe Text)) - (p;maybe (do p;Monad<Parser> - [_ (s;this (' #as))] - s;local-symbol))) + (p.maybe (do p.Monad<Parser> + [_ (s.this (' #as))] + s.local-symbol))) (def: (import-member-args^ imports type-vars) (-> Class-Imports (List TypeParam) (Syntax (List [Bool GenericType]))) - (s;tuple (p;some (p;seq (s;this? (' #?)) (generic-type^ imports type-vars))))) + (s.tuple (p.some (p.seq (s.this? (' #?)) (generic-type^ imports type-vars))))) (def: import-member-return-flags^ (Syntax [Bool Bool Bool]) - ($_ p;seq (s;this? (' #io)) (s;this? (' #try)) (s;this? (' #?)))) + ($_ p.seq (s.this? (' #io)) (s.this? (' #try)) (s.this? (' #?)))) (def: primitive-mode^ (Syntax Primitive-Mode) - (p;alt (s;this (' #manual)) - (s;this (' #auto)))) + (p.alt (s.this (' #manual)) + (s.this (' #auto)))) (def: (import-member-decl^ imports owner-vars) (-> Class-Imports (List TypeParam) (Syntax ImportMemberDecl)) - ($_ p;either - (s;form (do p;Monad<Parser> - [_ (s;this (' #enum)) - enum-members (p;some s;local-symbol)] + ($_ p.either + (s.form (do p.Monad<Parser> + [_ (s.this (' #enum)) + enum-members (p.some s.local-symbol)] (wrap (#EnumDecl enum-members)))) - (s;form (do p;Monad<Parser> - [tvars (p;default (list) (type-params^ imports)) - _ (s;this (' new)) + (s.form (do p.Monad<Parser> + [tvars (p.default (list) (type-params^ imports)) + _ (s.this (' new)) ?alias import-member-alias^ #let [total-vars (list/compose owner-vars tvars)] - ?prim-mode (p;maybe primitive-mode^) + ?prim-mode (p.maybe primitive-mode^) args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^] - (wrap (#ConstructorDecl [{#import-member-mode (maybe;default #AutoPrM ?prim-mode) - #import-member-alias (maybe;default "new" ?alias) + (wrap (#ConstructorDecl [{#import-member-mode (maybe.default #AutoPrM ?prim-mode) + #import-member-alias (maybe.default "new" ?alias) #import-member-kind #VirtualIMK #import-member-tvars tvars #import-member-args args @@ -1009,20 +1009,20 @@ #import-member-io? io?} {}])) )) - (s;form (do p;Monad<Parser> + (s.form (do p.Monad<Parser> [kind (: (Syntax ImportMethodKind) - (p;alt (s;this (' #static)) + (p.alt (s.this (' #static)) (wrap []))) - tvars (p;default (list) (type-params^ imports)) - name s;local-symbol + tvars (p.default (list) (type-params^ imports)) + name s.local-symbol ?alias import-member-alias^ #let [total-vars (list/compose owner-vars tvars)] - ?prim-mode (p;maybe primitive-mode^) + ?prim-mode (p.maybe primitive-mode^) args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^ return (generic-type^ imports total-vars)] - (wrap (#MethodDecl [{#import-member-mode (maybe;default #AutoPrM ?prim-mode) - #import-member-alias (maybe;default name ?alias) + (wrap (#MethodDecl [{#import-member-mode (maybe.default #AutoPrM ?prim-mode) + #import-member-alias (maybe.default name ?alias) #import-member-kind kind #import-member-tvars tvars #import-member-args args @@ -1032,14 +1032,14 @@ {#import-method-name name #import-method-return return }])))) - (s;form (do p;Monad<Parser> - [static? (s;this? (' #static)) - name s;local-symbol - ?prim-mode (p;maybe primitive-mode^) + (s.form (do p.Monad<Parser> + [static? (s.this? (' #static)) + name s.local-symbol + ?prim-mode (p.maybe primitive-mode^) gtype (generic-type^ imports owner-vars) - maybe? (s;this? (' #?)) - setter? (s;this? (' #!))] - (wrap (#FieldAccessDecl {#import-field-mode (maybe;default #AutoPrM ?prim-mode) + maybe? (s.this? (' #?)) + setter? (s.this? (' #!))] + (wrap (#FieldAccessDecl {#import-field-mode (maybe.default #AutoPrM ?prim-mode) #import-field-name name #import-field-static? static? #import-field-maybe? maybe? @@ -1050,15 +1050,15 @@ ## Generators (def: with-parens (-> JVM-Code JVM-Code) - (text;enclose ["(" ")"])) + (text.enclose ["(" ")"])) (def: with-brackets (-> JVM-Code JVM-Code) - (text;enclose ["[" "]"])) + (text.enclose ["[" "]"])) (def: spaced (-> (List JVM-Code) JVM-Code) - (text;join-with " ")) + (text.join-with " ")) (def: (privacy-modifier$ pm) (-> PrivacyModifier JVM-Code) @@ -1077,11 +1077,11 @@ (def: (annotation-param$ [name value]) (-> AnnotationParam JVM-Code) - (format name "=" (code;to-text value))) + (format name "=" (code.to-text value))) (def: (annotation$ [name params]) (-> Annotation JVM-Code) - (format "(" name " " "{" (text;join-with "\t" (list/map annotation-param$ params)) "}" ")")) + (format "(" name " " "{" (text.join-with "\t" (list/map annotation-param$ params)) "}" ")")) (def: (bound-kind$ kind) (-> BoundKind JVM-Code) @@ -1101,10 +1101,10 @@ (#GenericArray param) (format "(" array-type-name " " (generic-type$ param) ")") - (#GenericWildcard #;None) + (#GenericWildcard #.None) "?" - (#GenericWildcard (#;Some [bound-kind bound])) + (#GenericWildcard (#.Some [bound-kind bound])) (format (bound-kind$ bound-kind) (generic-type$ bound)))) (def: (type-param$ [name bounds]) @@ -1146,7 +1146,7 @@ (spaced (list "constant" name (with-brackets (spaced (list/map annotation$ anns))) (generic-type$ class) - (code;to-text value)) + (code.to-text value)) )) (#VariableField sm class) @@ -1167,7 +1167,7 @@ (def: (constructor-arg$ [class term]) (-> ConstructorArg JVM-Code) (with-brackets - (spaced (list (generic-type$ class) (code;to-text term))))) + (spaced (list (generic-type$ class) (code.to-text term))))) (def: (method-def$ replacer super-class [[name pm anns] method-def]) (-> (-> Code Code) Super-Class-Decl [MemberDecl MethodDef] JVM-Code) @@ -1182,7 +1182,7 @@ (with-brackets (spaced (list/map generic-type$ exs))) (with-brackets (spaced (list/map arg-decl$ arg-decls))) (with-brackets (spaced (list/map constructor-arg$ constructor-args))) - (code;to-text (pre-walk-replace replacer body)) + (code.to-text (pre-walk-replace replacer body)) ))) (#VirtualMethod final? strict-fp? type-vars arg-decls return-type body exs) @@ -1197,15 +1197,15 @@ (with-brackets (spaced (list/map generic-type$ exs))) (with-brackets (spaced (list/map arg-decl$ arg-decls))) (generic-type$ return-type) - (code;to-text (pre-walk-replace replacer body))))) + (code.to-text (pre-walk-replace replacer body))))) (#OverridenMethod strict-fp? class-decl type-vars arg-decls return-type body exs) - (let [super-replacer (parser->replacer (s;form (do p;Monad<Parser> - [_ (s;this (' ::super!)) - args (s;tuple (p;exactly (list;size arg-decls) s;any)) - #let [arg-decls' (: (List Text) (list/map (|>> product;right (simple-class$ (list))) + (let [super-replacer (parser->replacer (s.form (do p.Monad<Parser> + [_ (s.this (' ::super!)) + args (s.tuple (p.exactly (list.size arg-decls) s.any)) + #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ (list))) arg-decls))]] - (wrap (`' ((~ (code;text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls')))) + (wrap (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text.join-with "," arg-decls')))) (~' _jvm_this) (~@ args)))))))] (with-parens (spaced (list "override" @@ -1220,7 +1220,7 @@ (|> body (pre-walk-replace replacer) (pre-walk-replace super-replacer) - (code;to-text)) + (code.to-text)) )))) (#StaticMethod strict-fp? type-vars arg-decls return-type body exs) @@ -1234,7 +1234,7 @@ (with-brackets (spaced (list/map generic-type$ exs))) (with-brackets (spaced (list/map arg-decl$ arg-decls))) (generic-type$ return-type) - (code;to-text (pre-walk-replace replacer body))))) + (code.to-text (pre-walk-replace replacer body))))) (#AbstractMethod type-vars arg-decls return-type exs) (with-parens @@ -1272,18 +1272,18 @@ (syntax: #export (class: [#let [imports (class-imports *compiler*)]] [im inheritance-modifier^] [class-decl (class-decl^ imports)] - [#let [full-class-name (product;left class-decl) + [#let [full-class-name (product.left class-decl) imports (add-import [(short-class-name full-class-name) full-class-name] (class-imports *compiler*))]] - [#let [class-vars (product;right class-decl)]] - [super (p;default object-super-class + [#let [class-vars (product.right class-decl)]] + [super (p.default object-super-class (super-class-decl^ imports class-vars))] - [interfaces (p;default (list) - (s;tuple (p;some (super-class-decl^ imports class-vars))))] + [interfaces (p.default (list) + (s.tuple (p.some (super-class-decl^ imports class-vars))))] [annotations (annotations^ imports)] - [fields (p;some (field-decl^ imports class-vars))] - [methods (p;some (method-def^ imports class-vars))]) - {#;doc (doc "Allows defining JVM classes in Lux code." + [fields (p.some (field-decl^ imports class-vars))] + [methods (p.some (method-def^ imports class-vars))]) + {#.doc (doc "Allows defining JVM classes in Lux code." "For example:" (class: #final (TestClass A) [Runnable] ## Fields @@ -1314,12 +1314,12 @@ "(::resolve! container [value]) for calling the \"resolve\" method." )} (do Monad<Meta> - [current-module macro;current-module-name + [current-module macro.current-module-name #let [fully-qualified-class-name (format (sanitize current-module) "." full-class-name) field-parsers (list/map (field->parser fully-qualified-class-name) fields) - method-parsers (list/map (method->parser (product;right class-decl) fully-qualified-class-name) methods) - replacer (parser->replacer (list/fold p;either - (p;fail "") + method-parsers (list/map (method->parser (product.right class-decl) fully-qualified-class-name) methods) + replacer (parser->replacer (list/fold p.either + (p.fail "") (list/compose field-parsers method-parsers))) def-code (format "jvm class:" (spaced (list (class-decl$ class-decl) @@ -1329,19 +1329,19 @@ (with-brackets (spaced (list/map annotation$ annotations))) (with-brackets (spaced (list/map field-decl$ fields))) (with-brackets (spaced (list/map (method-def$ replacer super) methods))))))]] - (wrap (list (` ((~ (code;text def-code)))))))) + (wrap (list (` ((~ (code.text def-code)))))))) (syntax: #export (interface: [#let [imports (class-imports *compiler*)]] [class-decl (class-decl^ imports)] - [#let [full-class-name (product;left class-decl) + [#let [full-class-name (product.left class-decl) imports (add-import [(short-class-name full-class-name) full-class-name] (class-imports *compiler*))]] - [#let [class-vars (product;right class-decl)]] - [supers (p;default (list) - (s;tuple (p;some (super-class-decl^ imports class-vars))))] + [#let [class-vars (product.right class-decl)]] + [supers (p.default (list) + (s.tuple (p.some (super-class-decl^ imports class-vars))))] [annotations (annotations^ imports)] - [members (p;some (method-decl^ imports class-vars))]) - {#;doc (doc "Allows defining JVM interfaces." + [members (p.some (method-decl^ imports class-vars))]) + {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} (let [def-code (format "jvm interface:" @@ -1349,18 +1349,18 @@ (with-brackets (spaced (list/map super-class-decl$ supers))) (with-brackets (spaced (list/map annotation$ annotations))) (spaced (list/map method-decl$ members)))))] - (wrap (list (` ((~ (code;text def-code)))))) + (wrap (list (` ((~ (code.text def-code)))))) )) (syntax: #export (object [#let [imports (class-imports *compiler*)]] - [class-vars (s;tuple (p;some (type-param^ imports)))] - [super (p;default object-super-class + [class-vars (s.tuple (p.some (type-param^ imports)))] + [super (p.default object-super-class (super-class-decl^ imports class-vars))] - [interfaces (p;default (list) - (s;tuple (p;some (super-class-decl^ imports class-vars))))] + [interfaces (p.default (list) + (s.tuple (p.some (super-class-decl^ imports class-vars))))] [constructor-args (constructor-args^ imports class-vars)] - [methods (p;some (overriden-method-def^ imports))]) - {#;doc (doc "Allows defining anonymous classes." + [methods (p.some (overriden-method-def^ imports))]) + {#.doc (doc "Allows defining anonymous classes." "The 1st tuple corresponds to parent interfaces." "The 2nd tuple corresponds to arguments to the super class constructor." "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed." @@ -1375,15 +1375,15 @@ (with-brackets (spaced (list/map super-class-decl$ interfaces))) (with-brackets (spaced (list/map constructor-arg$ constructor-args))) (with-brackets (spaced (list/map (method-def$ id super) methods))))))] - (wrap (list (` ((~ (code;text def-code)))))))) + (wrap (list (` ((~ (code.text def-code)))))))) (syntax: #export (null) - {#;doc (doc "Null object reference." + {#.doc (doc "Null object reference." (null))} (wrap (list (` ("jvm null"))))) (def: #export (null? obj) - {#;doc (doc "Test for null object reference." + {#.doc (doc "Test for null object reference." (null? (null)) "=>" true @@ -1394,22 +1394,22 @@ ("jvm null?" obj)) (syntax: #export (??? expr) - {#;doc (doc "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." + {#.doc (doc "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it." (??? (: java/lang/String (null))) "=>" - #;None + #.None (??? "YOLO") "=>" - (#;Some "YOLO"))} + (#.Some "YOLO"))} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ expr)] (if ("jvm null?" (~ g!temp)) - #;None - (#;Some (~ g!temp))))))))) + #.None + (#.Some (~ g!temp))))))))) (syntax: #export (!!! expr) - {#;doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." - "A #;None would get translated into a (null)." + {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." + "A #.None would get translated into a (null)." (!!! (??? (: java/lang/Thread (null)))) "=>" (null) @@ -1418,48 +1418,48 @@ "YOLO")} (with-gensyms [g!value] (wrap (list (` ("lux case" (~ expr) - {(#;Some (~ g!value)) + {(#.Some (~ g!value)) (~ g!value) - #;None + #.None ("jvm null")})))))) (syntax: #export (try expr) - {#;doc (doc "Covers the expression in a try-catch block." - "If it succeeds, you get (#;Right result)." - "If it fails, you get (#;Left error+stack-traces-as-text)." + {#.doc (doc "Covers the expression in a try-catch block." + "If it succeeds, you get (#.Right result)." + "If it fails, you get (#.Left error+stack-traces-as-text)." (try (risky-computation input)))} (with-gensyms [g!_] - (wrap (list (`' ("lux try" (;function [(~ g!_)] (~ expr)))))))) + (wrap (list (`' ("lux try" (.function [(~ g!_)] (~ expr)))))))) (syntax: #export (instance? [#let [imports (class-imports *compiler*)]] [class (generic-type^ imports (list))] - [obj (p;maybe s;any)]) - {#;doc (doc "Checks whether an object is an instance of a particular class." + [obj (p.maybe s.any)]) + {#.doc (doc "Checks whether an object is an instance of a particular class." "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes." (instance? String "YOLO"))} (case obj - (#;Some obj) - (wrap (list (` ((~ (code;text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ obj))))) + (#.Some obj) + (wrap (list (` ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ obj))))) - #;None + #.None (do @ - [g!obj (macro;gensym "obj")] + [g!obj (macro.gensym "obj")] (wrap (list (` (: (-> (primitive "java.lang.Object") Bool) (function [(~ g!obj)] - ((~ (code;text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj)))))))) + ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj)))))))) )) (syntax: #export (synchronized lock body) - {#;doc (doc "Evaluates body, while holding a lock on a given object." + {#.doc (doc "Evaluates body, while holding a lock on a given object." (synchronized object-to-be-locked (exec (do-something ___) (do-something-else ___) (finish-the-computation ___))))} (wrap (list (` ("jvm synchronized" (~ lock) (~ body)))))) -(syntax: #export (do-to obj [methods (p;some partial-call^)]) - {#;doc (doc "Call a variety of methods on an object; then return the object." +(syntax: #export (do-to obj [methods (p.some partial-call^)]) + {#.doc (doc "Call a variety of methods on an object. Then, return the object." (do-to object (ClassName::method1 [arg0 arg1 arg2]) (ClassName::method2 [arg3 arg4 arg5])))} @@ -1473,13 +1473,13 @@ (let [def-name (if long-name? full-name (short-class-name full-name)) - params' (list/map (|>> product;left code;local-symbol) params)] - (` (def: (~ (code;symbol ["" def-name])) - {#;type? true - #;;jvm-class (~ (code;text full-name))} + params' (list/map (|>> product.left code.local-symbol) params)] + (` (def: (~ (code.symbol ["" def-name])) + {#.type? true + #..jvm-class (~ (code.text full-name))} Type (All [(~@ params')] - (primitive (~ (code;text (sanitize full-name))) + (primitive (~ (code.text (sanitize full-name))) [(~@ params')])))))) (def: (member-type-vars class-tvars member) @@ -1505,7 +1505,7 @@ (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] (do Monad<Meta> - [arg-inputs (monad;map @ + [arg-inputs (monad.map @ (: (-> [Bool GenericType] (Meta [Code Code])) (function [[maybe? _]] (with-gensyms [arg-name] @@ -1514,7 +1514,7 @@ arg-name)])))) import-member-args) #let [arg-classes (: (List Text) - (list/map (|>> product;right (simple-class$ (list/compose type-params import-member-tvars))) + (list/map (|>> product.right (simple-class$ (list/compose type-params import-member-tvars))) import-member-args)) arg-types (list/map (: (-> [Bool GenericType] Code) (function [[maybe? arg]] @@ -1523,8 +1523,8 @@ (` (Maybe (~ arg-type))) arg-type)))) import-member-args) - arg-function-inputs (list/map product;left arg-inputs) - arg-method-inputs (list/map product;right arg-inputs)]] + arg-function-inputs (list/map product.left arg-inputs) + arg-method-inputs (list/map product.right arg-inputs)]] (wrap [arg-function-inputs arg-method-inputs arg-classes arg-types]))) _ @@ -1540,7 +1540,7 @@ (:: Monad<Meta> wrap (class->type mode type-params (get@ #import-method-return method))) _ - (macro;fail "Only methods have return values."))) + (macro.fail "Only methods have return values."))) (def: (decorate-return-maybe member [return-type return-term]) (-> ImportMemberDecl [Code Code] [Code Code]) @@ -1550,7 +1550,7 @@ [(` (Maybe (~ return-type))) (` (??? (~ return-term)))] [return-type - (let [g!temp (code;symbol ["" "Ω"])] + (let [g!temp (code.symbol ["" "Ω"])] (` (let [(~ g!temp) (~ return-term)] (if (not (null? (:! (primitive "java.lang.Object") (~ g!temp)))) @@ -1579,12 +1579,12 @@ (def: (free-type-param? [name bounds]) (-> TypeParam Bool) (case bounds - #;Nil true + #.Nil true _ false)) (def: (type-param->type-arg [name _]) (-> TypeParam Code) - (code;symbol ["" name])) + (code.symbol ["" name])) (def: (with-mode-output mode output-type body) (-> Primitive-Mode GenericType Code Code) @@ -1672,38 +1672,38 @@ (let [[full-name class-tvars] class full-name (sanitize full-name) all-params (|> (member-type-vars class-tvars member) - (list;filter free-type-param?) + (list.filter free-type-param?) (list/map type-param->type-arg))] (case member (#EnumDecl enum-members) (do Monad<Meta> [#let [enum-type (: Code (case class-tvars - #;Nil - (` (primitive (~ (code;text full-name)))) + #.Nil + (` (primitive (~ (code.text full-name)))) _ (let [=class-tvars (|> class-tvars - (list;filter free-type-param?) + (list.filter free-type-param?) (list/map type-param->type-arg))] - (` (All [(~@ =class-tvars)] (primitive (~ (code;text full-name)) [(~@ =class-tvars)])))))) + (` (All [(~@ =class-tvars)] (primitive (~ (code.text full-name)) [(~@ =class-tvars)])))))) getter-interop (: (-> Text Code) (function [name] - (let [getter-name (code;symbol ["" (format method-prefix member-separator name)])] + (let [getter-name (code.symbol ["" (format method-prefix member-separator name)])] (` (def: (~ getter-name) (~ enum-type) - ((~ (code;text (format "jvm getstatic" ":" full-name ":" name)))))))))]] + ((~ (code.text (format "jvm getstatic" ":" full-name ":" name)))))))))]] (wrap (list/map getter-interop enum-members))) (#ConstructorDecl [commons _]) (do Monad<Meta> [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) - #let [def-name (code;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) - def-params (list (code;tuple arg-function-inputs)) - jvm-interop (|> (` ((~ (code;text (format "jvm new" ":" full-name ":" (text;join-with "," arg-classes)))) + #let [def-name (code.symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) + def-params (list (code.tuple arg-function-inputs)) + jvm-interop (|> (` ((~ (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes)))) (~@ arg-method-inputs))) (with-mode-inputs (get@ #import-member-mode commons) - (list;zip2 arg-classes arg-function-inputs))) + (list.zip2 arg-classes arg-function-inputs))) [return-type jvm-interop] (|> [return-type jvm-interop] (decorate-return-maybe member) (decorate-return-try member) @@ -1716,7 +1716,7 @@ (with-gensyms [g!obj] (do @ [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) - #let [def-name (code;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) + #let [def-name (code.symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) (^slots [#import-member-kind]) commons (^slots [#import-method-name]) method [jvm-op obj-ast class-ast] (: [Text (List Code) (List Code)] @@ -1738,15 +1738,15 @@ (list g!obj) (list (class-decl-type$ class))] ))) - def-params (#;Cons (code;tuple arg-function-inputs) obj-ast) - def-param-types (#;Cons (` [(~@ arg-types)]) class-ast) - jvm-interop (|> (` ((~ (code;text (format "jvm " jvm-op ":" full-name ":" import-method-name - ":" (text;join-with "," arg-classes)))) + def-params (#.Cons (code.tuple arg-function-inputs) obj-ast) + def-param-types (#.Cons (` [(~@ arg-types)]) class-ast) + jvm-interop (|> (` ((~ (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name + ":" (text.join-with "," arg-classes)))) (~@ obj-ast) (~@ arg-method-inputs))) (with-mode-output (get@ #import-member-mode commons) (get@ #import-method-return method)) (with-mode-inputs (get@ #import-member-mode commons) - (list;zip2 arg-classes arg-function-inputs))) + (list.zip2 arg-classes arg-function-inputs))) [return-type jvm-interop] (|> [return-type jvm-interop] (decorate-return-maybe member) (decorate-return-try member) @@ -1765,10 +1765,10 @@ base-gtype) tvar-asts (: (List Code) (|> class-tvars - (list;filter free-type-param?) + (list.filter free-type-param?) (list/map type-param->type-arg))) - getter-name (code;symbol ["" (format method-prefix member-separator import-field-name)]) - setter-name (code;symbol ["" (format method-prefix member-separator import-field-name "!")])] + getter-name (code.symbol ["" (format method-prefix member-separator import-field-name)]) + setter-name (code.symbol ["" (format method-prefix member-separator import-field-name "!")])] getter-interop (with-gensyms [g!obj] (let [getter-call (if import-field-static? getter-name @@ -1782,9 +1782,9 @@ getter-type (` (All [(~@ tvar-asts)] (~ getter-type))) getter-body (if import-field-static? (with-mode-field-get import-field-mode import-field-type - (` ((~ (code;text (format "jvm getstatic" ":" full-name ":" import-field-name)))))) + (` ((~ (code.text (format "jvm getstatic" ":" full-name ":" import-field-name)))))) (with-mode-field-get import-field-mode import-field-type - (` ((~ (code;text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj))))) + (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj))))) getter-body (if import-field-maybe? (` (??? (~ getter-body))) getter-body) @@ -1811,7 +1811,7 @@ (wrap (: (List Code) (list (` (def: (~ setter-call) (~ setter-type) - (io ((~ (code;text setter-command)) (~ setter-value)))))))))) + (io ((~ (code.text setter-command)) (~ setter-value)))))))))) (wrap (list)))] (wrap (list& getter-interop setter-interop))) ))) @@ -1838,22 +1838,22 @@ (-> ClassDecl (Meta ClassKind)) (let [class-name (sanitize class-name)] (case (load-class class-name) - (#;Right class) + (#.Right class) (:: Monad<Meta> wrap (if (interface? class) #Interface #Class)) - (#;Left _) - (macro;fail (format "Unknown class: " class-name))))) + (#.Left _) + (macro.fail (format "Unknown class: " class-name))))) (syntax: #export (import [#let [imports (class-imports *compiler*)]] - [long-name? (s;this? (' #long))] + [long-name? (s.this? (' #long))] [class-decl (class-decl^ imports)] - [#let [full-class-name (product;left class-decl) + [#let [full-class-name (product.left class-decl) imports (add-import [(short-class-name full-class-name) full-class-name] (class-imports *compiler*))]] - [members (p;some (import-member-decl^ imports (product;right class-decl)))]) - {#;doc (doc "Allows importing JVM classes, and using them as types." + [members (p.some (import-member-decl^ imports (product.right class-decl)))]) + {#.doc (doc "Allows importing JVM classes, and using them as types." "Their methods, fields and enum options can also be imported." "Also, classes which get imported into a module can also be referred-to with their short names in other macros that require JVM classes." "Examples:" @@ -1862,7 +1862,7 @@ (equals [Object] boolean) (wait [int] #io #try void)) "Special options can also be given for the return values." - "#? means that the values will be returned inside a Maybe type. That way, null becomes #;None." + "#? means that the values will be returned inside a Maybe type. That way, null becomes #.None." "#try means that the computation might throw an exception, and the return value will be wrapped by the Error type." "#io means the computation has side effects, and will be wrapped by the IO type." "These options must show up in the following order [#io #try #?] (although, each option can be used independently)." @@ -1901,13 +1901,13 @@ )} (do Monad<Meta> [kind (class-kind class-decl) - =members (monad;map @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)] + =members (monad.map @ (member-import$ (product.right class-decl) long-name? kind class-decl) members)] (wrap (list& (class-import$ long-name? class-decl) (list/join =members))))) (syntax: #export (array [#let [imports (class-imports *compiler*)]] [type (generic-type^ imports (list))] size) - {#;doc (doc "Create an array of the given type, with the given size." + {#.doc (doc "Create an array of the given type, with the given size." (array Object +10))} (case type (^template [<type> <array-op>] @@ -1923,44 +1923,44 @@ ["char" "jvm cnewarray"]) _ - (wrap (list (` ("jvm anewarray" (~ (code;text (generic-type$ type))) (~ size))))))) + (wrap (list (` ("jvm anewarray" (~ (code.text (generic-type$ type))) (~ size))))))) (syntax: #export (array-length array) - {#;doc (doc "Gives the length of an array." + {#.doc (doc "Gives the length of an array." (array-length my-array))} (wrap (list (` ("jvm arraylength" (~ array)))))) (def: (type->class-name type) (-> Type (Meta Text)) (case type - (#;Primitive name params) + (#.Primitive name params) (:: Monad<Meta> wrap name) - (#;Apply A F) - (case (type;apply (list A) F) - #;None - (macro;fail (format "Cannot apply type: " (type;to-text F) " to " (type;to-text A))) + (#.Apply A F) + (case (type.apply (list A) F) + #.None + (macro.fail (format "Cannot apply type: " (type.to-text F) " to " (type.to-text A))) - (#;Some type') + (#.Some type') (type->class-name type')) - (#;Named _ type') + (#.Named _ type') (type->class-name type') - #;Unit + #.Unit (:: Monad<Meta> wrap "java.lang.Object") - (^or #;Void (#;Var _) (#;Ex _) (#;Bound _) (#;Sum _) (#;Product _) (#;Function _) (#;UnivQ _) (#;ExQ _)) - (macro;fail (format "Cannot convert to JvmType: " (type;to-text type))) + (^or #.Void (#.Var _) (#.Ex _) (#.Bound _) (#.Sum _) (#.Product _) (#.Function _) (#.UnivQ _) (#.ExQ _)) + (macro.fail (format "Cannot convert to JvmType: " (type.to-text type))) )) (syntax: #export (array-read idx array) - {#;doc (doc "Loads an element from an array." + {#.doc (doc "Loads an element from an array." (array-read +10 my-array))} (case array - [_ (#;Symbol array-name)] + [_ (#.Symbol array-name)] (do Monad<Meta> - [array-type (macro;find-type array-name) + [array-type (macro.find-type array-name) array-jvm-type (type->class-name array-type)] (case array-jvm-type (^template [<type> <array-op>] @@ -1981,15 +1981,15 @@ _ (with-gensyms [g!array] (wrap (list (` (let [(~ g!array) (~ array)] - (;;array-read (~ idx) (~ g!array))))))))) + (..array-read (~ idx) (~ g!array))))))))) (syntax: #export (array-write idx value array) - {#;doc (doc "Stores an element into an array." + {#.doc (doc "Stores an element into an array." (array-write +10 my-object my-array))} (case array - [_ (#;Symbol array-name)] + [_ (#.Symbol array-name)] (do Monad<Meta> - [array-type (macro;find-type array-name) + [array-type (macro.find-type array-name) array-jvm-type (type->class-name array-type)] (case array-jvm-type (^template [<type> <array-op>] @@ -2010,14 +2010,14 @@ _ (with-gensyms [g!array] (wrap (list (` (let [(~ g!array) (~ array)] - (;;array-write (~ idx) (~ value) (~ g!array))))))))) + (..array-write (~ idx) (~ value) (~ g!array))))))))) (def: simple-bindings^ (Syntax (List [Text Code])) - (s;tuple (p;some (p;seq s;local-symbol s;any)))) + (s.tuple (p.some (p.seq s.local-symbol s.any)))) (syntax: #export (with-open [bindings simple-bindings^] body) - {#;doc (doc "Creates a local-binding with the desired resources, and runs the body (assumed to be in the IO type)." + {#.doc (doc "Creates a local-binding with the desired resources, and runs the body (assumed to be in the IO type)." "Afterwards, closes all resources (assumed to be subclasses of java.io.Closeable), and returns the value resulting from running the body." (with-open [my-res1 (res1-constructor ___) my-res2 (res1-constructor ___)] @@ -2027,30 +2027,30 @@ (do-one-last-thing foo bar))))} (with-gensyms [g!output g!_] (let [inits (list/join (list/map (function [[res-name res-ctor]] - (list (code;symbol ["" res-name]) res-ctor)) + (list (code.symbol ["" res-name]) res-ctor)) bindings)) closes (list/map (function [res] - (` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code;symbol ["" (product;left res)])))))) + (` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code.symbol ["" (product.left res)])))))) bindings)] (wrap (list (` (do Monad<IO> [(~@ inits) (~ g!output) (~ body) - (~' #let) [(~ g!_) (exec (~@ (list;reverse closes)) [])]] + (~' #let) [(~ g!_) (exec (~@ (list.reverse closes)) [])]] ((~' wrap) (~ g!output))))))))) (syntax: #export (class-for [#let [imports (class-imports *compiler*)]] [type (generic-type^ imports (list))]) - {#;doc (doc "Loads the class as a java.lang.Class object." + {#.doc (doc "Loads the class as a java.lang.Class object." (class-for java/lang/String))} - (wrap (list (` ("jvm load-class" (~ (code;text (simple-class$ (list) type)))))))) + (wrap (list (` ("jvm load-class" (~ (code.text (simple-class$ (list) type)))))))) (def: get-compiler (Meta Compiler) (function [compiler] - (#;Right [compiler compiler]))) + (#.Right [compiler compiler]))) (def: #export (resolve class) - {#;doc (doc "Given a potentially unqualified class name, qualifies it if necessary." + {#.doc (doc "Given a potentially unqualified class name, qualifies it if necessary." (resolve "String") => "java.lang.String")} diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index d3e08169e..8eaeaae63 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."} +(.module: {#.doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."} lux (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -7,22 +7,22 @@ (coll [list])))) (type: #export (IO a) - {#;doc "A type that represents synchronous, effectful computations that may interact with the outside world."} + {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."} (-> Void a)) (macro: #export (io tokens state) - {#;doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." + {#.doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." "Great for wrapping effectful computations (which will not be performed until the IO is \"run\")." (io (exec (log! msg) "Some value...")))} (case tokens (^ (list value)) - (let [blank (: Code [["" +0 +0] (#;Symbol ["" ""])])] - (#;Right [state (list (` ("lux function" (~ blank) (~ blank) (~ value))))])) + (let [blank (: Code [["" +0 +0] (#.Symbol ["" ""])])] + (#.Right [state (list (` ("lux function" (~ blank) (~ blank) (~ value))))])) _ - (#;Left "Wrong syntax for io"))) + (#.Left "Wrong syntax for io"))) (struct: #export _ (Functor IO) (def: (map f ma) @@ -44,7 +44,7 @@ (io ((mma (:! Void [])) (:! Void []))))) (def: #export (run action) - {#;doc "A way to execute IO computations and perform their side-effects."} + {#.doc "A way to execute IO computations and perform their side-effects."} (All [a] (-> (IO a) a)) (action (:! Void []))) @@ -54,28 +54,28 @@ (struct: #export _ (Functor Process) (def: (map f ma) - (io (:: e;Functor<Error> map f (run ma))))) + (io (:: e.Functor<Error> map f (run ma))))) (struct: #export _ (Applicative Process) (def: functor Functor<Process>) (def: (wrap x) - (io (:: e;Applicative<Error> wrap x))) + (io (:: e.Applicative<Error> wrap x))) (def: (apply ff fa) - (io (:: e;Applicative<Error> apply (run ff) (run fa))))) + (io (:: e.Applicative<Error> apply (run ff) (run fa))))) (struct: #export _ (Monad Process) (def: applicative Applicative<Process>) (def: (join mma) (case (run mma) - (#e;Success ma) + (#e.Success ma) ma - (#e;Error error) - (io (#e;Error error))))) + (#e.Error error) + (io (#e.Error error))))) (def: #export (fail error) (All [a] (-> Text (Process a))) - (io (#e;Error error))) + (io (#e.Error error))) diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux index 49e27aecd..46558014e 100644 --- a/stdlib/source/lux/lang/syntax.lux +++ b/stdlib/source/lux/lang/syntax.lux @@ -24,7 +24,7 @@ ## Lux Code nodes/tokens are annotated with cursor meta-data ## (file-name, line, column) to keep track of their provenance and ## location, which is helpful for documentation and debugging. -(;module: +(.module: lux (lux (control monad ["p" parser "p/" Monad<Parser>] @@ -51,42 +51,42 @@ ## It operates recursively in order to produce the longest continuous ## chunk of white-space. (def: (space^ where) - (-> Cursor (l;Lexer [Cursor Text])) - (p;either (do p;Monad<Parser> - [content (l;many (l;one-of white-space))] - (wrap [(update@ #;column (n/+ (text;size content)) where) + (-> Cursor (l.Lexer [Cursor Text])) + (p.either (do p.Monad<Parser> + [content (l.many (l.one-of white-space))] + (wrap [(update@ #.column (n/+ (text.size content)) where) content])) ## New-lines must be handled as a separate case to ensure line ## information is handled properly. - (do p;Monad<Parser> - [content (l;many (l;one-of new-line))] + (do p.Monad<Parser> + [content (l.many (l.one-of new-line))] (wrap [(|> where - (update@ #;line (n/+ (text;size content))) - (set@ #;column +0)) + (update@ #.line (n/+ (text.size content))) + (set@ #.column +0)) content])) )) ## Single-line comments can start anywhere, but only go up to the ## next new-line. (def: (single-line-comment^ where) - (-> Cursor (l;Lexer [Cursor Text])) - (do p;Monad<Parser> - [_ (l;this "##") - comment (l;some (l;none-of new-line)) - _ (l;this new-line)] + (-> Cursor (l.Lexer [Cursor Text])) + (do p.Monad<Parser> + [_ (l.this "##") + comment (l.some (l.none-of new-line)) + _ (l.this new-line)] (wrap [(|> where - (update@ #;line n/inc) - (set@ #;column +0)) + (update@ #.line n/inc) + (set@ #.column +0)) comment]))) ## This is just a helper parser to find text which doesn't run into ## any special character sequences for multi-line comments. (def: comment-bound^ - (l;Lexer Unit) - ($_ p;either - (l;this new-line) - (l;this ")#") - (l;this "#("))) + (l.Lexer Unit) + ($_ p.either + (l.this new-line) + (l.this ")#") + (l.this "#("))) ## Multi-line comments are bounded by #( these delimiters, #(and, they may ## also be nested)# )#. @@ -94,26 +94,26 @@ ## That is, any nested comment must have matched delimiters. ## Unbalanced comments ought to be rejected as invalid code. (def: (multi-line-comment^ where) - (-> Cursor (l;Lexer [Cursor Text])) - (do p;Monad<Parser> - [_ (l;this "#(")] + (-> Cursor (l.Lexer [Cursor Text])) + (do p.Monad<Parser> + [_ (l.this "#(")] (loop [comment "" - where (update@ #;column (n/+ +2) where)] - ($_ p;either + where (update@ #.column (n/+ +2) where)] + ($_ p.either ## These are normal chunks of commented text. (do @ - [chunk (l;many (l;not comment-bound^))] + [chunk (l.many (l.not comment-bound^))] (recur (format comment chunk) (|> where - (update@ #;column (n/+ (text;size chunk)))))) + (update@ #.column (n/+ (text.size chunk)))))) ## This is a special rule to handle new-lines within ## comments properly. (do @ - [_ (l;this new-line)] + [_ (l.this new-line)] (recur (format comment new-line) (|> where - (update@ #;line n/inc) - (set@ #;column +0)))) + (update@ #.line n/inc) + (set@ #.column +0)))) ## This is the rule for handling nested sub-comments. ## Ultimately, the whole comment is just treated as text ## (the comment must respect the syntax structure, but the @@ -126,8 +126,8 @@ sub-where)) ## Finally, this is the rule for closing the comment. (do @ - [_ (l;this ")#")] - (wrap [(update@ #;column (n/+ +2) where) + [_ (l.this ")#")] + (wrap [(update@ #.column (n/+ +2) where) comment])) )))) @@ -138,8 +138,8 @@ ## from being used in any situation (alternatively, forcing one type ## of comment to be the only usable one). (def: (comment^ where) - (-> Cursor (l;Lexer [Cursor Text])) - (p;either (single-line-comment^ where) + (-> Cursor (l.Lexer [Cursor Text])) + (p.either (single-line-comment^ where) (multi-line-comment^ where))) ## To simplify parsing, I remove any left-padding that an Code token @@ -147,15 +147,15 @@ ## Left-padding is assumed to be either white-space or a comment. ## The cursor gets updated, but the padding gets ignored. (def: (left-padding^ where) - (-> Cursor (l;Lexer Cursor)) - ($_ p;either - (do p;Monad<Parser> + (-> Cursor (l.Lexer Cursor)) + ($_ p.either + (do p.Monad<Parser> [[where comment] (comment^ where)] (left-padding^ where)) - (do p;Monad<Parser> + (do p.Monad<Parser> [[where white-space] (space^ where)] (left-padding^ where)) - (:: p;Monad<Parser> wrap where))) + (:: p.Monad<Parser> wrap where))) ## Escaped character sequences follow the usual syntax of ## back-slash followed by a letter (e.g. \n). @@ -163,10 +163,10 @@ ## and 4 characters long (e.g. \u12aB). ## Escaped characters may show up in Char and Text literals. (def: escaped-char^ - (l;Lexer [Nat Text]) - (p;after (l;this "\\") - (do p;Monad<Parser> - [code l;any] + (l.Lexer [Nat Text]) + (p.after (l.this "\\") + (do p.Monad<Parser> + [code l.any] (case code ## Handle special cases. "t" (wrap [+2 "\t"]) @@ -180,169 +180,169 @@ ## Handle unicode escapes. "u" - (do p;Monad<Parser> - [code (l;between +1 +4 l;hexadecimal)] - (wrap (case (|> code (format "+") (:: number;Hex@Codec<Text,Nat> decode)) - (#;Right value) - [(n/+ +2 (text;size code)) (text;from-code value)] + (do p.Monad<Parser> + [code (l.between +1 +4 l.hexadecimal)] + (wrap (case (|> code (format "+") (:: number.Hex@Codec<Text,Nat> decode)) + (#.Right value) + [(n/+ +2 (text.size code)) (text.from-code value)] _ (undefined)))) _ - (p;fail (format "Invalid escaping syntax: " (%t code))))))) + (p.fail (format "Invalid escaping syntax: " (%t code))))))) ## These are very simple parsers that just cut chunks of text in ## specific shapes and then use decoders already present in the ## standard library to actually produce the values from the literals. (def: rich-digit - (l;Lexer Text) - (p;either l;decimal - (p;after (l;this "_") (p/wrap "")))) + (l.Lexer Text) + (p.either l.decimal + (p.after (l.this "_") (p/wrap "")))) (def: rich-digits^ - (l;Lexer Text) - (l;seq l;decimal - (l;some rich-digit))) + (l.Lexer Text) + (l.seq l.decimal + (l.some rich-digit))) (def: (marker^ token) - (-> Text (l;Lexer Text)) - (p;after (l;this token) (p/wrap token))) + (-> Text (l.Lexer Text)) + (p.after (l.this token) (p/wrap token))) (do-template [<name> <tag> <lexer> <codec>] [(def: #export (<name> where) - (-> Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad<Parser> [chunk <lexer>] (case (:: <codec> decode chunk) - (#;Left error) - (p;fail error) + (#.Left error) + (p.fail error) - (#;Right value) - (wrap [(update@ #;column (n/+ (text;size chunk)) where) + (#.Right value) + (wrap [(update@ #.column (n/+ (text.size chunk)) where) [where (<tag> value)]]))))] - [bool #;Bool - (p;either (marker^ "true") (marker^ "false")) - bool;Codec<Text,Bool>] + [bool #.Bool + (p.either (marker^ "true") (marker^ "false")) + bool.Codec<Text,Bool>] - [int #;Int - (l;seq (p;default "" (l;one-of "-")) + [int #.Int + (l.seq (p.default "" (l.one-of "-")) rich-digits^) - number;Codec<Text,Int>] + number.Codec<Text,Int>] - [deg #;Deg - (l;seq (l;one-of ".") + [deg #.Deg + (l.seq (l.one-of ".") rich-digits^) - number;Codec<Text,Deg>] + number.Codec<Text,Deg>] ) (def: (nat-char where) - (-> Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> - [_ (l;this "#\"") - [where' char] (: (l;Lexer [Cursor Text]) - ($_ p;either + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad<Parser> + [_ (l.this "#\"") + [where' char] (: (l.Lexer [Cursor Text]) + ($_ p.either ## Normal text characters. (do @ - [normal (l;none-of "\\\"\n")] + [normal (l.none-of "\\\"\n")] (wrap [(|> where - (update@ #;column n/inc)) + (update@ #.column n/inc)) normal])) ## Must handle escaped ## chars separately. (do @ [[chars-consumed char] escaped-char^] (wrap [(|> where - (update@ #;column (n/+ chars-consumed))) + (update@ #.column (n/+ chars-consumed))) char])))) - _ (l;this "\"") - #let [char (maybe;assume (text;nth +0 char))]] + _ (l.this "\"") + #let [char (maybe.assume (text.nth +0 char))]] (wrap [(|> where' - (update@ #;column n/inc)) - [where (#;Nat char)]]))) + (update@ #.column n/inc)) + [where (#.Nat char)]]))) (def: (normal-nat where) - (-> Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> - [chunk (l;seq (l;one-of "+") + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad<Parser> + [chunk (l.seq (l.one-of "+") rich-digits^)] - (case (:: number;Codec<Text,Nat> decode chunk) - (#;Left error) - (p;fail error) + (case (:: number.Codec<Text,Nat> decode chunk) + (#.Left error) + (p.fail error) - (#;Right value) - (wrap [(update@ #;column (n/+ (text;size chunk)) where) - [where (#;Nat value)]])))) + (#.Right value) + (wrap [(update@ #.column (n/+ (text.size chunk)) where) + [where (#.Nat value)]])))) (def: #export (nat where) - (-> Cursor (l;Lexer [Cursor Code])) - (p;either (normal-nat where) + (-> Cursor (l.Lexer [Cursor Code])) + (p.either (normal-nat where) (nat-char where))) (def: (normal-frac where) - (-> Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> - [chunk ($_ l;seq - (p;default "" (l;one-of "-")) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad<Parser> + [chunk ($_ l.seq + (p.default "" (l.one-of "-")) rich-digits^ - (l;one-of ".") + (l.one-of ".") rich-digits^ - (p;default "" - ($_ l;seq - (l;one-of "eE") - (p;default "" (l;one-of "+-")) + (p.default "" + ($_ l.seq + (l.one-of "eE") + (p.default "" (l.one-of "+-")) rich-digits^)))] - (case (:: number;Codec<Text,Frac> decode chunk) - (#;Left error) - (p;fail error) + (case (:: number.Codec<Text,Frac> decode chunk) + (#.Left error) + (p.fail error) - (#;Right value) - (wrap [(update@ #;column (n/+ (text;size chunk)) where) - [where (#;Frac value)]])))) + (#.Right value) + (wrap [(update@ #.column (n/+ (text.size chunk)) where) + [where (#.Frac value)]])))) (def: frac-ratio-fragment - (l;Lexer Frac) - (<| (p;codec number;Codec<Text,Frac>) - (:: p;Monad<Parser> map (function [digits] + (l.Lexer Frac) + (<| (p.codec number.Codec<Text,Frac>) + (:: p.Monad<Parser> map (function [digits] (format digits ".0"))) rich-digits^)) (def: (ratio-frac where) - (-> Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> - [chunk ($_ l;seq - (p;default "" (l;one-of "-")) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad<Parser> + [chunk ($_ l.seq + (p.default "" (l.one-of "-")) rich-digits^ - (l;one-of "/") + (l.one-of "/") rich-digits^) - value (l;local chunk + value (l.local chunk (do @ - [signed? (l;this? "-") + [signed? (l.this? "-") numerator frac-ratio-fragment - _ (l;this? "/") + _ (l.this? "/") denominator frac-ratio-fragment - _ (p;assert "Denominator cannot be 0." + _ (p.assert "Denominator cannot be 0." (not (f/= 0.0 denominator)))] (wrap (|> numerator (f/* (if signed? -1.0 1.0)) (f// denominator)))))] - (wrap [(update@ #;column (n/+ (text;size chunk)) where) - [where (#;Frac value)]]))) + (wrap [(update@ #.column (n/+ (text.size chunk)) where) + [where (#.Frac value)]]))) (def: #export (frac where) - (-> Cursor (l;Lexer [Cursor Code])) - (p;either (normal-frac where) + (-> Cursor (l.Lexer [Cursor Code])) + (p.either (normal-frac where) (ratio-frac where))) ## This parser looks so complex because text in Lux can be multi-line ## and there are rules regarding how this is handled. (def: #export (text where) - (-> Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad<Parser> [## Lux text "is delimited by double-quotes", as usual in most ## programming languages. - _ (l;this "\"") + _ (l.this "\"") ## I must know what column the text body starts at (which is ## always 1 column after the left-delimiting quote). ## This is important because, when procesing subsequent lines, @@ -350,8 +350,8 @@ ## as many spaces as necessary to be column-aligned. ## This helps ensure that the formatting on the text in the ## source-code matches the formatting of the Text value. - #let [offset-column (n/inc (get@ #;column where))] - [where' text-read] (: (l;Lexer [Cursor Text]) + #let [offset-column (n/inc (get@ #.column where))] + [where' text-read] (: (l.Lexer [Cursor Text]) ## I must keep track of how much of the ## text body has been read, how far the ## cursor has progressed, and whether I'm @@ -359,9 +359,9 @@ ## processing normal text body. (loop [text-read "" where (|> where - (update@ #;column n/inc)) + (update@ #.column n/inc)) must-have-offset? false] - (p;either (if must-have-offset? + (p.either (if must-have-offset? ## If I'm at the start of a ## new line, I must ensure the ## space-offset is at least @@ -369,30 +369,30 @@ ## the text's body's column, ## to ensure they are aligned. (do @ - [offset (l;many (l;one-of " ")) - #let [offset-size (text;size offset)]] + [offset (l.many (l.one-of " ")) + #let [offset-size (text.size offset)]] (if (n/>= offset-column offset-size) ## Any extra offset ## becomes part of the ## text's body. (recur (|> offset - (text;split offset-column) - (maybe;default (undefined)) - product;right + (text.split offset-column) + (maybe.default (undefined)) + product.right (format text-read)) (|> where - (update@ #;column (n/+ offset-size))) + (update@ #.column (n/+ offset-size))) false) - (p;fail (format "Each line of a multi-line text must have an appropriate offset!\n" + (p.fail (format "Each line of a multi-line text must have an appropriate offset!\n" "Expected: " (%i (nat-to-int offset-column)) " columns.\n" " Actual: " (%i (nat-to-int offset-size)) " columns.\n")))) - ($_ p;either + ($_ p.either ## Normal text characters. (do @ - [normal (l;many (l;none-of "\\\"\n"))] + [normal (l.many (l.none-of "\\\"\n"))] (recur (format text-read normal) (|> where - (update@ #;column (n/+ (text;size normal)))) + (update@ #.column (n/+ (text.size normal)))) false)) ## Must handle escaped ## chars separately. @@ -400,13 +400,13 @@ [[chars-consumed char] escaped-char^] (recur (format text-read char) (|> where - (update@ #;column (n/+ chars-consumed))) + (update@ #.column (n/+ chars-consumed))) false)) ## The text ends when it ## reaches the right-delimiter. (do @ - [_ (l;this "\"")] - (wrap [(update@ #;column n/inc where) + [_ (l.this "\"")] + (wrap [(update@ #.column n/inc where) text-read])))) ## If a new-line is ## encountered, it gets @@ -414,14 +414,14 @@ ## the loop is alerted that the ## next line must have an offset. (do @ - [_ (l;this new-line)] + [_ (l.this new-line)] (recur (format text-read new-line) (|> where - (update@ #;line n/inc) - (set@ #;column +0)) + (update@ #.line n/inc) + (set@ #.column +0)) true)))))] (wrap [where' - [where (#;Text text-read)]]))) + [where (#.Text text-read)]]))) ## Form and tuple syntax is mostly the same, differing only in the ## delimiters involved. @@ -429,32 +429,32 @@ (do-template [<name> <tag> <open> <close>] [(def: (<name> where ast) (-> Cursor - (-> Cursor (l;Lexer [Cursor Code])) - (l;Lexer [Cursor Code])) - (do p;Monad<Parser> - [_ (l;this <open>) + (-> Cursor (l.Lexer [Cursor Code])) + (l.Lexer [Cursor Code])) + (do p.Monad<Parser> + [_ (l.this <open>) [where' elems] (loop [elems (: (Sequence Code) - sequence;empty) + sequence.empty) where where] - (p;either (do @ + (p.either (do @ [## Must update the cursor as I ## go along, to keep things accurate. [where' elem] (ast where)] - (recur (sequence;add elem elems) + (recur (sequence.add elem elems) where')) (do @ [## Must take into account any ## padding present before the ## end-delimiter. where' (left-padding^ where) - _ (l;this <close>)] - (wrap [(update@ #;column n/inc where') - (sequence;to-list elems)]))))] + _ (l.this <close>)] + (wrap [(update@ #.column n/inc where') + (sequence.to-list elems)]))))] (wrap [where' [where (<tag> elems)]])))] - [form #;Form "(" ")"] - [tuple #;Tuple "[" "]"] + [form #.Form "(" ")"] + [tuple #.Tuple "[" "]"] ) ## Records are almost (syntactically) the same as forms and tuples, @@ -468,34 +468,34 @@ ## macros. (def: (record where ast) (-> Cursor - (-> Cursor (l;Lexer [Cursor Code])) - (l;Lexer [Cursor Code])) - (do p;Monad<Parser> - [_ (l;this "{") + (-> Cursor (l.Lexer [Cursor Code])) + (l.Lexer [Cursor Code])) + (do p.Monad<Parser> + [_ (l.this "{") [where' elems] (loop [elems (: (Sequence [Code Code]) - sequence;empty) + sequence.empty) where where] - (p;either (do @ + (p.either (do @ [[where' key] (ast where) [where' val] (ast where')] - (recur (sequence;add [key val] elems) + (recur (sequence.add [key val] elems) where')) (do @ [where' (left-padding^ where) - _ (l;this "}")] - (wrap [(update@ #;column n/inc where') - (sequence;to-list elems)]))))] + _ (l.this "}")] + (wrap [(update@ #.column n/inc where') + (sequence.to-list elems)]))))] (wrap [where' - [where (#;Record elems)]]))) + [where (#.Record elems)]]))) ## The parts of an identifier are separated by a single mark. -## E.g. module;name. +## E.g. module.name. ## Only one such mark may be used in an identifier, since there ## can only be 2 parts to an identifier (the module [before the ## mark], and the name [after the mark]). ## There are also some extra rules regarding identifier syntax, ## encoded on the parser. -(def: identifier-separator Text ";") +(def: identifier-separator Text ".") ## A Lux identifier is a pair of chunks of text, where the first-part ## refers to the module that gives context to the identifier, and the @@ -511,13 +511,13 @@ ## Additionally, the first character in an identifier's part cannot be ## a digit, to avoid confusion with regards to numbers. (def: ident-part^ - (l;Lexer Text) - (do p;Monad<Parser> + (l.Lexer Text) + (do p.Monad<Parser> [#let [digits "0123456789" delimiters (format "()[]{}#\"" identifier-separator) space (format white-space new-line) - head-lexer (l;none-of (format digits delimiters space)) - tail-lexer (l;some (l;none-of (format delimiters space)))] + head-lexer (l.none-of (format digits delimiters space)) + tail-lexer (l.some (l.none-of (format delimiters space)))] head head-lexer tail tail-lexer] (wrap (format head tail)))) @@ -525,28 +525,28 @@ (def: current-module-mark Text (format identifier-separator identifier-separator)) (def: (ident^ current-module aliases) - (-> Text Aliases (l;Lexer [Ident Nat])) - ($_ p;either + (-> Text Aliases (l.Lexer [Ident Nat])) + ($_ p.either ## When an identifier starts with 2 marks, its module is ## taken to be the current-module being compiled at the moment. ## This can be useful when mentioning identifiers and tags ## inside quoted/templated code in macros. - (do p;Monad<Parser> - [_ (l;this current-module-mark) + (do p.Monad<Parser> + [_ (l.this current-module-mark) def-name ident-part^] (wrap [[current-module def-name] - (n/+ +2 (text;size def-name))])) + (n/+ +2 (text.size def-name))])) ## If the identifier is prefixed by the mark, but no module ## part, the module is assumed to be "lux" (otherwise known as ## the 'prelude'). ## This makes it easy to refer to definitions in that module, ## since it is the most fundamental module in the entire ## standard library. - (do p;Monad<Parser> - [_ (l;this identifier-separator) + (do p.Monad<Parser> + [_ (l.this identifier-separator) def-name ident-part^] (wrap [["lux" def-name] - (n/inc (text;size def-name))])) + (n/inc (text.size def-name))])) ## Not all identifiers must be specified with a module part. ## If that part is not provided, the identifier will be created ## with the empty "" text as the module. @@ -556,19 +556,19 @@ ## Function arguments and local-variables may not be referred-to ## using identifiers with module parts, so being able to specify ## identifiers with empty modules helps with those use-cases. - (do p;Monad<Parser> + (do p.Monad<Parser> [first-part ident-part^] - (p;either (do @ - [_ (l;this identifier-separator) + (p.either (do @ + [_ (l.this identifier-separator) second-part ident-part^] - (wrap [[(|> aliases (dict;get first-part) (maybe;default first-part)) + (wrap [[(|> aliases (dict.get first-part) (maybe.default first-part)) second-part] ($_ n/+ - (text;size first-part) + (text.size first-part) +1 - (text;size second-part))])) + (text.size second-part))])) (wrap [["" first-part] - (text;size first-part)]))))) + (text.size first-part)]))))) ## The only (syntactic) difference between a symbol and a tag (both ## being identifiers), is that tags must be prefixed with a hash-sign @@ -579,26 +579,26 @@ ## construction and de-structuring (during pattern-matching). (do-template [<name> <tag> <lexer> <extra>] [(def: #export (<name> current-module aliases where) - (-> Text Aliases Cursor (l;Lexer [Cursor Code])) - (do p;Monad<Parser> + (-> Text Aliases Cursor (l.Lexer [Cursor Code])) + (do p.Monad<Parser> [[value length] <lexer>] - (wrap [(update@ #;column (|>> ($_ n/+ <extra> length)) where) + (wrap [(update@ #.column (|>> ($_ n/+ <extra> length)) where) [where (<tag> value)]])))] - [symbol #;Symbol (ident^ current-module aliases) +0] - [tag #;Tag (p;after (l;this "#") (ident^ current-module aliases)) +1] + [symbol #.Symbol (ident^ current-module aliases) +0] + [tag #.Tag (p.after (l.this "#") (ident^ current-module aliases)) +1] ) (exception: #export End-Of-File) (exception: #export Unrecognized-Input) (def: (ast current-module aliases) - (-> Text Aliases Cursor (l;Lexer [Cursor Code])) - (: (-> Cursor (l;Lexer [Cursor Code])) + (-> Text Aliases Cursor (l.Lexer [Cursor Code])) + (: (-> Cursor (l.Lexer [Cursor Code])) (function ast' [where] - (do p;Monad<Parser> + (do p.Monad<Parser> [where (left-padding^ where)] - ($_ p;either + ($_ p.either (form where ast') (tuple where ast') (record where ast') @@ -611,17 +611,17 @@ (tag current-module aliases where) (text where) (do @ - [end? l;end?] + [end? l.end?] (if end? - (p;fail (End-Of-File current-module)) - (p;fail (Unrecognized-Input current-module)))) + (p.fail (End-Of-File current-module)) + (p.fail (Unrecognized-Input current-module)))) ))))) (def: #export (read current-module aliases [where offset source]) - (-> Text Aliases Source (e;Error [Source Code])) - (case (p;run [offset source] (ast current-module aliases where)) - (#e;Error error) - (#e;Error error) + (-> Text Aliases Source (e.Error [Source Code])) + (case (p.run [offset source] (ast current-module aliases where)) + (#e.Error error) + (#e.Error error) - (#e;Success [[offset' remaining] [where' output]]) - (#e;Success [[where' offset' remaining] output]))) + (#e.Success [[offset' remaining] [where' output]]) + (#e.Success [[where' offset' remaining] output]))) diff --git a/stdlib/source/lux/lang/type.lux b/stdlib/source/lux/lang/type.lux index 217320ab2..ab680cb6c 100644 --- a/stdlib/source/lux/lang/type.lux +++ b/stdlib/source/lux/lang/type.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Basic functionality for working with types."} +(.module: {#.doc "Basic functionality for working with types."} [lux #- function] (lux (control [eq #+ Eq] [monad #+ do Monad]) @@ -14,29 +14,29 @@ (def: (beta-reduce env type) (-> (List Type) Type Type) (case type - (#;Primitive name params) - (#;Primitive name (list/map (beta-reduce env) params)) + (#.Primitive name params) + (#.Primitive name (list/map (beta-reduce env) params)) (^template [<tag>] (<tag> left right) (<tag> (beta-reduce env left) (beta-reduce env right))) - ([#;Sum] [#;Product] - [#;Function] [#;Apply]) + ([#.Sum] [#.Product] + [#.Function] [#.Apply]) (^template [<tag>] (<tag> old-env def) (case old-env - #;Nil + #.Nil (<tag> env def) _ (<tag> (list/map (beta-reduce env) old-env) def))) - ([#;UnivQ] - [#;ExQ]) + ([#.UnivQ] + [#.ExQ]) - (#;Bound idx) - (maybe;default (error! (text/compose "Unknown type var: " (nat/encode idx))) - (list;nth idx env)) + (#.Bound idx) + (maybe.default (error! (text/compose "Unknown type var: " (nat/encode idx))) + (list.nth idx env)) _ type @@ -46,44 +46,44 @@ (struct: #export _ (Eq Type) (def: (= x y) (case [x y] - [(#;Primitive xname xparams) (#;Primitive yname yparams)] + [(#.Primitive xname xparams) (#.Primitive yname yparams)] (and (text/= xname yname) - (n/= (list;size yparams) (list;size xparams)) - (list/fold (;function [[x y] prev] (and prev (= x y))) + (n/= (list.size yparams) (list.size xparams)) + (list/fold (.function [[x y] prev] (and prev (= x y))) true - (list;zip2 xparams yparams))) + (list.zip2 xparams yparams))) (^template [<tag>] [<tag> <tag>] true) - ([#;Void] [#;Unit]) + ([#.Void] [#.Unit]) (^template [<tag>] [(<tag> xid) (<tag> yid)] (n/= yid xid)) - ([#;Var] [#;Ex] [#;Bound]) + ([#.Var] [#.Ex] [#.Bound]) - (^or [(#;Function xleft xright) (#;Function yleft yright)] - [(#;Apply xleft xright) (#;Apply yleft yright)]) + (^or [(#.Function xleft xright) (#.Function yleft yright)] + [(#.Apply xleft xright) (#.Apply yleft yright)]) (and (= xleft yleft) (= xright yright)) - [(#;Named xname xtype) (#;Named yname ytype)] + [(#.Named xname xtype) (#.Named yname ytype)] (and (ident/= xname yname) (= xtype ytype)) (^template [<tag>] [(<tag> xL xR) (<tag> yL yR)] (and (= xL yL) (= xR yR))) - ([#;Sum] [#;Product]) + ([#.Sum] [#.Product]) - (^or [(#;UnivQ xenv xbody) (#;UnivQ yenv ybody)] - [(#;ExQ xenv xbody) (#;ExQ yenv ybody)]) - (and (n/= (list;size yenv) (list;size xenv)) + (^or [(#.UnivQ xenv xbody) (#.UnivQ yenv ybody)] + [(#.ExQ xenv xbody) (#.ExQ yenv ybody)]) + (and (n/= (list.size yenv) (list.size xenv)) (= xbody ybody) - (list/fold (;function [[x y] prev] (and prev (= x y))) + (list/fold (.function [[x y] prev] (and prev (= x y))) true - (list;zip2 xenv yenv))) + (list.zip2 xenv yenv))) _ false @@ -102,14 +102,14 @@ _ [num-args type])))] - [flatten-univ-q #;UnivQ] - [flatten-ex-q #;ExQ] + [flatten-univ-q #.UnivQ] + [flatten-ex-q #.ExQ] ) (def: #export (flatten-function type) (-> Type [(List Type) Type]) (case type - (#;Function in out') + (#.Function in out') (let [[ins out] (flatten-function out')] [(list& in ins) out]) @@ -119,7 +119,7 @@ (def: #export (flatten-application type) (-> Type [Type (List Type)]) (case type - (#;Apply arg func') + (#.Apply arg func') (let [[func args] (flatten-application func')] [func (list/compose args (list arg))]) @@ -136,88 +136,88 @@ _ (list type)))] - [flatten-variant #;Sum] - [flatten-tuple #;Product] + [flatten-variant #.Sum] + [flatten-tuple #.Product] ) (def: #export (apply params func) (-> (List Type) Type (Maybe Type)) (case params - #;Nil - (#;Some func) + #.Nil + (#.Some func) - (#;Cons param params') + (#.Cons param params') (case func (^template [<tag>] (<tag> env body) (|> body (beta-reduce (list& func param env)) (apply params'))) - ([#;UnivQ] [#;ExQ]) + ([#.UnivQ] [#.ExQ]) - (#;Apply A F) + (#.Apply A F) (apply (list& A params) F) - (#;Named name unnamed) + (#.Named name unnamed) (apply params unnamed) _ - #;None))) + #.None))) (def: #export (to-ast type) (-> Type Code) (case type - (#;Primitive name params) - (` (#;Primitive (~ (code;text name)) + (#.Primitive name params) + (` (#.Primitive (~ (code.text name)) (list (~@ (list/map to-ast params))))) (^template [<tag>] <tag> (` <tag>)) - ([#;Void] [#;Unit]) + ([#.Void] [#.Unit]) (^template [<tag>] (<tag> idx) - (` (<tag> (~ (code;nat idx))))) - ([#;Var] [#;Ex] [#;Bound]) + (` (<tag> (~ (code.nat idx))))) + ([#.Var] [#.Ex] [#.Bound]) (^template [<tag>] (<tag> left right) (` (<tag> (~ (to-ast left)) (~ (to-ast right))))) - ([#;Function] [#;Apply]) + ([#.Function] [#.Apply]) (^template [<tag> <macro> <flattener>] (<tag> left right) (` (<macro> (~@ (list/map to-ast (<flattener> type)))))) - ([#;Sum | flatten-variant] - [#;Product & flatten-tuple]) + ([#.Sum | flatten-variant] + [#.Product & flatten-tuple]) - (#;Named name sub-type) - (code;symbol name) + (#.Named name sub-type) + (code.symbol name) (^template [<tag>] (<tag> env body) (` (<tag> (list (~@ (list/map to-ast env))) (~ (to-ast body))))) - ([#;UnivQ] [#;ExQ]) + ([#.UnivQ] [#.ExQ]) )) (def: #export (to-text type) (-> Type Text) (case type - (#;Primitive name params) + (#.Primitive name params) (case params - #;Nil + #.Nil ($_ text/compose "(primitive " name ")") _ - ($_ text/compose "(primitive " name " " (|> params (list/map to-text) list;reverse (list;interpose " ") (list/fold text/compose "")) ")")) + ($_ text/compose "(primitive " name " " (|> params (list/map to-text) list.reverse (list.interpose " ") (list/fold text/compose "")) ")")) - #;Void + #.Void "Void" - #;Unit + #.Unit "Unit" (^template [<tag> <open> <close> <flatten>] @@ -225,51 +225,51 @@ ($_ text/compose <open> (|> (<flatten> type) (list/map to-text) - list;reverse - (list;interpose " ") + list.reverse + (list.interpose " ") (list/fold text/compose "")) <close>)) - ([#;Sum "(| " ")" flatten-variant] - [#;Product "[" "]" flatten-tuple]) + ([#.Sum "(| " ")" flatten-variant] + [#.Product "[" "]" flatten-tuple]) - (#;Function input output) + (#.Function input output) (let [[ins out] (flatten-function type)] ($_ text/compose "(-> " (|> ins (list/map to-text) - list;reverse - (list;interpose " ") + list.reverse + (list.interpose " ") (list/fold text/compose "")) " " (to-text out) ")")) - (#;Bound idx) + (#.Bound idx) (nat/encode idx) - (#;Var id) + (#.Var id) ($_ text/compose "⌈v:" (nat/encode id) "⌋") - (#;Ex id) + (#.Ex id) ($_ text/compose "⟨e:" (nat/encode id) "⟩") - (#;Apply param fun) + (#.Apply param fun) (let [[type-func type-args] (flatten-application type)] - ($_ text/compose "(" (to-text type-func) " " (|> type-args (list/map to-text) list;reverse (list;interpose " ") (list/fold text/compose "")) ")")) + ($_ text/compose "(" (to-text type-func) " " (|> type-args (list/map to-text) list.reverse (list.interpose " ") (list/fold text/compose "")) ")")) (^template [<tag> <desc>] (<tag> env body) - ($_ text/compose "(" <desc> " {" (|> env (list/map to-text) (text;join-with " ")) "} " (to-text body) ")")) - ([#;UnivQ "All"] - [#;ExQ "Ex"]) + ($_ text/compose "(" <desc> " {" (|> env (list/map to-text) (text.join-with " ")) "} " (to-text body) ")")) + ([#.UnivQ "All"] + [#.ExQ "Ex"]) - (#;Named [module name] type) - ($_ text/compose module ";" name) + (#.Named [module name] type) + ($_ text/compose module "." name) )) (def: #export (un-alias type) (-> Type Type) (case type - (#;Named _ (#;Named ident type')) - (un-alias (#;Named ident type')) + (#.Named _ (#.Named ident type')) + (un-alias (#.Named ident type')) _ type)) @@ -277,7 +277,7 @@ (def: #export (un-name type) (-> Type Type) (case type - (#;Named ident type') + (#.Named ident type') (un-name type') _ @@ -287,36 +287,36 @@ [(def: #export (<name> types) (-> (List Type) Type) (case types - #;Nil + #.Nil <base> - (#;Cons type #;Nil) + (#.Cons type #.Nil) type - (#;Cons type types') + (#.Cons type types') (<ctor> type (<name> types'))))] - [variant Void #;Sum] - [tuple Unit #;Product] + [variant Void #.Sum] + [tuple Unit #.Product] ) (def: #export (function inputs output) (-> (List Type) Type Type) (case inputs - #;Nil + #.Nil output - (#;Cons input inputs') - (#;Function input (function inputs' output)))) + (#.Cons input inputs') + (#.Function input (function inputs' output)))) (def: #export (application params quant) (-> (List Type) Type Type) (case params - #;Nil + #.Nil quant - (#;Cons param params') - (application params' (#;Apply param quant)))) + (#.Cons param params') + (application params' (#.Apply param quant)))) (do-template [<name> <tag>] [(def: #export (<name> size body) @@ -325,23 +325,23 @@ +0 body _ (<tag> (list) (<name> (n/dec size) body))))] - [univ-q #;UnivQ] - [ex-q #;ExQ] + [univ-q #.UnivQ] + [ex-q #.ExQ] ) (def: #export (quantified? type) (-> Type Bool) (case type - (#;Named [module name] _type) + (#.Named [module name] _type) (quantified? _type) - (#;Apply A F) - (maybe;default false - (do maybe;Monad<Maybe> + (#.Apply A F) + (maybe.default false + (do maybe.Monad<Maybe> [applied (apply (list A) F)] (wrap (quantified? applied)))) - (^or (#;UnivQ _) (#;ExQ _)) + (^or (#.UnivQ _) (#.ExQ _)) true _ @@ -351,4 +351,4 @@ (-> Nat Type Type) (case level +0 elem-type - _ (#;Primitive "#Array" (list (array (n/dec level) elem-type))))) + _ (#.Primitive "#Array" (list (array (n/dec level) elem-type))))) diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux index 9dc1a6565..9dc7e81b0 100644 --- a/stdlib/source/lux/lang/type/check.lux +++ b/stdlib/source/lux/lang/type/check.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Type-checking functionality."} +(.module: {#.doc "Type-checking functionality."} lux (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -28,7 +28,7 @@ #verdict Bool}) (type: #export (Check a) - (-> Type-Context (e;Error [Type-Context a]))) + (-> Type-Context (e.Error [Type-Context a]))) (type: #export Type-Vars (List [Var (Maybe Type)])) @@ -37,11 +37,11 @@ (def: (map f fa) (function [context] (case (fa context) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success [context' output]) - (#e;Success [context' (f output)]) + (#e.Success [context' output]) + (#e.Success [context' (f output)]) )))) (struct: #export _ (Applicative Check) @@ -49,21 +49,21 @@ (def: (wrap x) (function [context] - (#e;Success [context x]))) + (#e.Success [context x]))) (def: (apply ff fa) (function [context] (case (ff context) - (#e;Success [context' f]) + (#e.Success [context' f]) (case (fa context') - (#e;Success [context'' a]) - (#e;Success [context'' (f a)]) + (#e.Success [context'' a]) + (#e.Success [context'' (f a)]) - (#e;Error error) - (#e;Error error)) + (#e.Error error) + (#e.Error error)) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) ))) ) @@ -73,16 +73,16 @@ (def: (join ffa) (function [context] (case (ffa context) - (#e;Success [context' fa]) + (#e.Success [context' fa]) (case (fa context') - (#e;Success [context'' a]) - (#e;Success [context'' a]) + (#e.Success [context'' a]) + (#e.Success [context'' a]) - (#e;Error error) - (#e;Error error)) + (#e.Error error) + (#e.Error error)) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) ))) ) @@ -91,248 +91,248 @@ (def: (var::get id plist) (-> Var Type-Vars (Maybe (Maybe Type))) (case plist - #;Nil - #;None + #.Nil + #.None - (#;Cons [var-id var-type] + (#.Cons [var-id var-type] plist') (if (n/= id var-id) - (#;Some var-type) + (#.Some var-type) (var::get id plist')) )) (def: (var::put id value plist) (-> Var (Maybe Type) Type-Vars Type-Vars) (case plist - #;Nil + #.Nil (list [id value]) - (#;Cons [var-id var-type] + (#.Cons [var-id var-type] plist') (if (n/= id var-id) - (#;Cons [var-id value] + (#.Cons [var-id value] plist') - (#;Cons [var-id var-type] + (#.Cons [var-id var-type] (var::put id value plist'))) )) (def: (var::remove id plist) (-> Var Type-Vars Type-Vars) (case plist - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [var-id var-type] + (#.Cons [var-id var-type] plist') (if (n/= id var-id) plist' - (#;Cons [var-id var-type] + (#.Cons [var-id var-type] (var::remove id plist'))) )) ## [[Logic]] (def: #export (run context proc) - (All [a] (-> Type-Context (Check a) (e;Error a))) + (All [a] (-> Type-Context (Check a) (e.Error a))) (case (proc context) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success [context' output]) - (#e;Success output))) + (#e.Success [context' output]) + (#e.Success output))) (def: #export (throw exception message) - (All [a] (-> ex;Exception Text (Check a))) + (All [a] (-> ex.Exception Text (Check a))) (function [context] - (ex;throw exception message))) + (ex.throw exception message))) (def: #export existential - {#;doc "A producer of existential types."} + {#.doc "A producer of existential types."} (Check [Nat Type]) (function [context] - (let [id (get@ #;ex-counter context)] - (#e;Success [(update@ #;ex-counter n/inc context) - [id (#;Ex id)]])))) + (let [id (get@ #.ex-counter context)] + (#e.Success [(update@ #.ex-counter n/inc context) + [id (#.Ex id)]])))) (do-template [<name> <outputT> <fail> <succeed>] [(def: #export (<name> id) (-> Var (Check <outputT>)) (function [context] - (case (|> context (get@ #;var-bindings) (var::get id)) - (^or (#;Some (#;Some (#;Var _))) - (#;Some #;None)) - (#e;Success [context <fail>]) + (case (|> context (get@ #.var-bindings) (var::get id)) + (^or (#.Some (#.Some (#.Var _))) + (#.Some #.None)) + (#e.Success [context <fail>]) - (#;Some (#;Some bound)) - (#e;Success [context <succeed>]) + (#.Some (#.Some bound)) + (#e.Success [context <succeed>]) - #;None - (ex;throw Unknown-Type-Var (nat/encode id)))))] + #.None + (ex.throw Unknown-Type-Var (nat/encode id)))))] [bound? Bool false true] - [read (Maybe Type) #;None (#;Some bound)] + [read (Maybe Type) #.None (#.Some bound)] ) (def: (peek id) (-> Var (Check Type)) (function [context] - (case (|> context (get@ #;var-bindings) (var::get id)) - (#;Some (#;Some bound)) - (#e;Success [context bound]) + (case (|> context (get@ #.var-bindings) (var::get id)) + (#.Some (#.Some bound)) + (#e.Success [context bound]) - (#;Some #;None) - (ex;throw Unbound-Type-Var (nat/encode id)) + (#.Some #.None) + (ex.throw Unbound-Type-Var (nat/encode id)) - #;None - (ex;throw Unknown-Type-Var (nat/encode id))))) + #.None + (ex.throw Unknown-Type-Var (nat/encode id))))) (def: #export (write type id) (-> Type Var (Check Unit)) (function [context] - (case (|> context (get@ #;var-bindings) (var::get id)) - (#;Some (#;Some bound)) - (ex;throw Cannot-Rebind-Var + (case (|> context (get@ #.var-bindings) (var::get id)) + (#.Some (#.Some bound)) + (ex.throw Cannot-Rebind-Var ($_ text/compose " Var: " (nat/encode id) "\n" - " Wanted Type: " (type;to-text type) "\n" - "Current Type: " (type;to-text bound))) + " Wanted Type: " (type.to-text type) "\n" + "Current Type: " (type.to-text bound))) - (#;Some #;None) - (#e;Success [(update@ #;var-bindings (var::put id (#;Some type)) context) + (#.Some #.None) + (#e.Success [(update@ #.var-bindings (var::put id (#.Some type)) context) []]) - #;None - (ex;throw Unknown-Type-Var (nat/encode id))))) + #.None + (ex.throw Unknown-Type-Var (nat/encode id))))) (def: (update type id) (-> Type Var (Check Unit)) (function [context] - (case (|> context (get@ #;var-bindings) (var::get id)) - (#;Some _) - (#e;Success [(update@ #;var-bindings (var::put id (#;Some type)) context) + (case (|> context (get@ #.var-bindings) (var::get id)) + (#.Some _) + (#e.Success [(update@ #.var-bindings (var::put id (#.Some type)) context) []]) - #;None - (ex;throw Unknown-Type-Var (nat/encode id))))) + #.None + (ex.throw Unknown-Type-Var (nat/encode id))))) (def: #export var (Check [Var Type]) (function [context] - (let [id (get@ #;var-counter context)] - (#e;Success [(|> context - (update@ #;var-counter n/inc) - (update@ #;var-bindings (var::put id #;None))) - [id (#;Var id)]])))) + (let [id (get@ #.var-counter context)] + (#e.Success [(|> context + (update@ #.var-counter n/inc) + (update@ #.var-bindings (var::put id #.None))) + [id (#.Var id)]])))) (def: get-bindings (Check (List [Var (Maybe Type)])) (function [context] - (#e;Success [context - (get@ #;var-bindings context)]))) + (#e.Success [context + (get@ #.var-bindings context)]))) (def: (set-bindings value) (-> (List [Var (Maybe Type)]) (Check Unit)) (function [context] - (#e;Success [(set@ #;var-bindings value context) + (#e.Success [(set@ #.var-bindings value context) []]))) (def: (apply-type! funcT argT) (-> Type Type (Check Type)) (case funcT - (#;Var func-id) + (#.Var func-id) (do Monad<Check> [?funcT' (read func-id)] (case ?funcT' - #;None - (throw Invalid-Type-Application (type;to-text (#;Apply argT funcT))) + #.None + (throw Invalid-Type-Application (type.to-text (#.Apply argT funcT))) - (#;Some funcT') + (#.Some funcT') (apply-type! funcT' argT))) _ (function [context] - (case (type;apply (list argT) funcT) - #;None - (ex;throw Invalid-Type-Application (type;to-text (#;Apply argT funcT))) + (case (type.apply (list argT) funcT) + #.None + (ex.throw Invalid-Type-Application (type.to-text (#.Apply argT funcT))) - (#;Some output) - (#e;Success [context output]))))) + (#.Some output) + (#e.Success [context output]))))) (type: #export Ring (Set Var)) -(def: empty-ring Ring (set;new number;Hash<Nat>)) +(def: empty-ring Ring (set.new number.Hash<Nat>)) (def: #export (ring id) (-> Var (Check Ring)) (function [context] (loop [current id - output (set;add id empty-ring)] - (case (|> context (get@ #;var-bindings) (var::get current)) - (#;Some (#;Some type)) + output (set.add id empty-ring)] + (case (|> context (get@ #.var-bindings) (var::get current)) + (#.Some (#.Some type)) (case type - (#;Var post) + (#.Var post) (if (n/= id post) - (#e;Success [context output]) - (recur post (set;add post output))) + (#e.Success [context output]) + (recur post (set.add post output))) _ - (#e;Success [context empty-ring])) + (#e.Success [context empty-ring])) - (#;Some #;None) - (#e;Success [context output]) + (#.Some #.None) + (#e.Success [context output]) - #;None - (ex;throw Unknown-Type-Var (nat/encode current)))))) + #.None + (ex.throw Unknown-Type-Var (nat/encode current)))))) (def: #export fresh-context Type-Context - {#;var-counter +0 - #;ex-counter +0 - #;var-bindings (list) + {#.var-counter +0 + #.ex-counter +0 + #.var-bindings (list) }) (def: (attempt op) (All [a] (-> (Check a) (Check (Maybe a)))) (function [context] (case (op context) - (#e;Success [context' output]) - (#e;Success [context' (#;Some output)]) + (#e.Success [context' output]) + (#e.Success [context' (#.Some output)]) - (#e;Error _) - (#e;Success [context #;None])))) + (#e.Error _) + (#e.Success [context #.None])))) (def: #export (fail message) (All [a] (-> Text (Check a))) (function [context] - (#e;Error message))) + (#e.Error message))) (def: #export (assert message test) (-> Text Bool (Check Unit)) (function [context] (if test - (#e;Success [context []]) - (#e;Error message)))) + (#e.Success [context []]) + (#e.Error message)))) (def: (either left right) (All [a] (-> (Check a) (Check a) (Check a))) (function [context] (case (left context) - (#e;Success [context' output]) - (#e;Success [context' output]) + (#e.Success [context' output]) + (#e.Success [context' output]) - (#e;Error _) + (#e.Error _) (right context)))) (def: (assumed? [e a] assumptions) (-> [Type Type] (List Assumption) (Maybe Bool)) - (:: maybe;Monad<Maybe> map product;right - (list;find (function [[[fe fa] status]] + (:: maybe.Monad<Maybe> map product.right + (list.find (function [[[fe fa] status]] (and (type/= e fe) (type/= a fa))) assumptions))) (def: (assume! ea status assumptions) (-> [Type Type] Bool (List Assumption) (List Assumption)) - (#;Cons [ea status] assumptions)) + (#.Cons [ea status] assumptions)) (def: (on id type then else) (All [a] @@ -344,24 +344,24 @@ then) (do Monad<Check> [ring (ring id) - _ (assert "" (n/> +1 (set;size ring))) - _ (monad;map @ (update type) (set;to-list ring))] + _ (assert "" (n/> +1 (set.size ring))) + _ (monad.map @ (update type) (set.to-list ring))] then) (do Monad<Check> [?bound (read id)] - (else (maybe;default (#;Var id) ?bound))))) + (else (maybe.default (#.Var id) ?bound))))) (def: (link-2 left right) (-> Var Var (Check Unit)) (do Monad<Check> - [_ (write (#;Var right) left)] - (write (#;Var left) right))) + [_ (write (#.Var right) left)] + (write (#.Var left) right))) (def: (link-3 interpose to from) (-> Var Var Var (Check Unit)) (do Monad<Check> - [_ (update (#;Var interpose) from)] - (update (#;Var to) interpose))) + [_ (update (#.Var interpose) from)] + (update (#.Var to) interpose))) (def: (check-vars check' assumptions idE idA) (-> (-> Type Type (List Assumption) (Check (List Assumption))) @@ -375,61 +375,61 @@ abound (attempt (peek idA))] (case [ebound abound] ## Link the 2 variables circularily - [#;None #;None] + [#.None #.None] (do @ [_ (link-2 idE idA)] (wrap assumptions)) ## Interpose new variable between 2 existing links - [(#;Some etype) #;None] + [(#.Some etype) #.None] (case etype - (#;Var targetE) + (#.Var targetE) (do @ [_ (link-3 idA targetE idE)] (wrap assumptions)) _ - (check' etype (#;Var idA) assumptions)) + (check' etype (#.Var idA) assumptions)) ## Interpose new variable between 2 existing links - [#;None (#;Some atype)] + [#.None (#.Some atype)] (case atype - (#;Var targetA) + (#.Var targetA) (do @ [_ (link-3 idE targetA idA)] (wrap assumptions)) _ - (check' (#;Var idE) atype assumptions)) + (check' (#.Var idE) atype assumptions)) - [(#;Some etype) (#;Some atype)] + [(#.Some etype) (#.Some atype)] (case [etype atype] - [(#;Var targetE) (#;Var targetA)] + [(#.Var targetE) (#.Var targetA)] (do @ [ringE (ring idE) ringA (ring idA)] - (if (:: set;Eq<Set> = ringE ringA) + (if (:: set.Eq<Set> = ringE ringA) (wrap assumptions) ## Fuse 2 rings (do @ - [_ (monad;fold @ (function [interpose to] + [_ (monad.fold @ (function [interpose to] (do @ [_ (link-3 interpose to idE)] (wrap interpose))) targetE - (set;to-list ringA))] + (set.to-list ringA))] (wrap assumptions)))) - [(#;Var targetE) _] + [(#.Var targetE) _] (do @ [ring (ring idE) - _ (monad;map @ (update atype) (set;to-list ring))] + _ (monad.map @ (update atype) (set.to-list ring))] (wrap assumptions)) - [_ (#;Var targetA)] + [_ (#.Var targetA)] (do @ [ring (ring idA) - _ (monad;map @ (update etype) (set;to-list ring))] + _ (monad.map @ (update etype) (set.to-list ring))] (wrap assumptions)) _ @@ -439,8 +439,8 @@ (All [a] (-> (-> Unit Text) (Check a) (Check a))) (function [context] (case (check context) - (#e;Error error) - (#e;Error (case error + (#e.Error error) + (#e.Error (case error "" (on-error []) @@ -458,27 +458,27 @@ [Type Type] [Type Type] (Check (List Assumption))) (case [eFT aFT] - (^or [(#;UnivQ _ _) (#;Ex _)] [(#;UnivQ _ _) (#;Var _)]) + (^or [(#.UnivQ _ _) (#.Ex _)] [(#.UnivQ _ _) (#.Var _)]) (do Monad<Check> [eFT' (apply-type! eFT eAT)] - (check' eFT' (#;Apply aAT aFT) assumptions)) + (check' eFT' (#.Apply aAT aFT) assumptions)) - (^or [(#;Ex _) (#;UnivQ _ _)] [(#;Var _) (#;UnivQ _ _)]) + (^or [(#.Ex _) (#.UnivQ _ _)] [(#.Var _) (#.UnivQ _ _)]) (do Monad<Check> [aFT' (apply-type! aFT aAT)] - (check' (#;Apply eAT eFT) aFT' assumptions)) + (check' (#.Apply eAT eFT) aFT' assumptions)) - (^or [(#;Ex _) _] [_ (#;Ex _)]) + (^or [(#.Ex _) _] [_ (#.Ex _)]) (do Monad<Check> [assumptions (check' eFT aFT assumptions)] (check' eAT aAT assumptions)) - [(#;Var id) _] + [(#.Var id) _] (do Monad<Check> [?rFT (read id)] (case ?rFT - (#;Some rFT) - (check' (#;Apply eAT rFT) (#;Apply aAT aFT) assumptions) + (#.Some rFT) + (check' (#.Apply eAT rFT) (#.Apply aAT aFT) assumptions) _ (do Monad<Check> @@ -487,12 +487,12 @@ a' (apply-type! aFT aAT)] (check' e' a' assumptions)))) - [_ (#;Var id)] + [_ (#.Var id)] (do Monad<Check> [?rFT (read id)] (case ?rFT - (#;Some rFT) - (check' (#;Apply eAT eFT) (#;Apply aAT rFT) assumptions) + (#.Some rFT) + (check' (#.Apply eAT eFT) (#.Apply aAT rFT) assumptions) _ (do Monad<Check> @@ -505,53 +505,53 @@ (fail ""))) (def: #export (check' expected actual assumptions) - {#;doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} + {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} (-> Type Type (List Assumption) (Check (List Assumption))) (if (is expected actual) (check/wrap assumptions) (with-error-stack (function [_] (Type-Check-Failed ($_ text/compose - "Expected: " (type;to-text expected) "\n\n" - " Actual: " (type;to-text actual)))) + "Expected: " (type.to-text expected) "\n\n" + " Actual: " (type.to-text actual)))) (case [expected actual] - [(#;Var idE) (#;Var idA)] + [(#.Var idE) (#.Var idA)] (check-vars check' assumptions idE idA) - [(#;Var id) _] + [(#.Var id) _] (on id actual (check/wrap assumptions) (function [bound] (check' bound actual assumptions))) - [_ (#;Var id)] + [_ (#.Var id)] (on id expected (check/wrap assumptions) (function [bound] (check' expected bound assumptions))) (^template [<fe> <fa>] - [(#;Apply A1 <fe>) (#;Apply A2 <fa>)] + [(#.Apply A1 <fe>) (#.Apply A2 <fa>)] (check-apply check' assumptions [A1 <fe>] [A2 <fa>])) - ([F1 (#;Ex ex)] - [(#;Ex ex) F2] - [F1 (#;Var id)] - [(#;Var id) F2]) + ([F1 (#.Ex ex)] + [(#.Ex ex) F2] + [F1 (#.Var id)] + [(#.Var id) F2]) - [(#;Apply A F) _] + [(#.Apply A F) _] (let [fx-pair [expected actual]] (case (assumed? fx-pair assumptions) - (#;Some ?) + (#.Some ?) (if ? (check/wrap assumptions) (fail "")) - #;None + #.None (do Monad<Check> [expected' (apply-type! F A)] (check' expected' actual (assume! fx-pair true assumptions))))) - [_ (#;Apply A F)] + [_ (#.Apply A F)] (do Monad<Check> [actual' (apply-type! F A)] (check' expected actual' assumptions)) @@ -562,8 +562,8 @@ [[_ paramT] <instancer> expected' (apply-type! expected paramT)] (check' expected' actual assumptions))) - ([#;UnivQ ;;existential] - [#;ExQ ;;var]) + ([#.UnivQ ..existential] + [#.ExQ ..var]) (^template [<tag> <instancer>] [_ (<tag> _)] @@ -571,18 +571,18 @@ [[_ paramT] <instancer> actual' (apply-type! actual paramT)] (check' expected actual' assumptions))) - ([#;UnivQ ;;var] - [#;ExQ ;;existential]) + ([#.UnivQ ..var] + [#.ExQ ..existential]) - [(#;Primitive e-name e-params) (#;Primitive a-name a-params)] + [(#.Primitive e-name e-params) (#.Primitive a-name a-params)] (if (and (text/= e-name a-name) - (n/= (list;size e-params) - (list;size a-params))) + (n/= (list.size e-params) + (list.size a-params))) (do Monad<Check> - [assumptions (monad;fold Monad<Check> + [assumptions (monad.fold Monad<Check> (function [[e a] assumptions] (check' e a assumptions)) assumptions - (list;zip2 e-params a-params))] + (list.zip2 e-params a-params))] (check/wrap assumptions)) (fail "")) @@ -594,59 +594,59 @@ (do Monad<Check> [assumptions (check' eL aL assumptions)] (check' eR aR assumptions))) - ([#;Void #;Sum] - [#;Unit #;Product]) + ([#.Void #.Sum] + [#.Unit #.Product]) - [(#;Function eI eO) (#;Function aI aO)] + [(#.Function eI eO) (#.Function aI aO)] (do Monad<Check> [assumptions (check' aI eI assumptions)] (check' eO aO assumptions)) - [(#;Ex e!id) (#;Ex a!id)] + [(#.Ex e!id) (#.Ex a!id)] (if (n/= e!id a!id) (check/wrap assumptions) (fail "")) - [(#;Named _ ?etype) _] + [(#.Named _ ?etype) _] (check' ?etype actual assumptions) - [_ (#;Named _ ?atype)] + [_ (#.Named _ ?atype)] (check' expected ?atype assumptions) _ (fail ""))))) (def: #export (check expected actual) - {#;doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} + {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} (-> Type Type (Check Unit)) (do Monad<Check> [assumptions (check' expected actual (list))] (wrap []))) (def: #export (checks? expected actual) - {#;doc "A simple type-checking function that just returns a yes/no answer."} + {#.doc "A simple type-checking function that just returns a yes/no answer."} (-> Type Type Bool) (case (run fresh-context (check expected actual)) - (#e;Error error) + (#e.Error error) false - (#e;Success _) + (#e.Success _) true)) (def: #export get-context (Check Type-Context) (function [context] - (#e;Success [context context]))) + (#e.Success [context context]))) (def: #export (clean inputT) (-> Type (Check Type)) (case inputT - (#;Primitive name paramsT+) + (#.Primitive name paramsT+) (do Monad<Check> - [paramsT+' (monad;map @ clean paramsT+)] - (wrap (#;Primitive name paramsT+'))) + [paramsT+' (monad.map @ clean paramsT+)] + (wrap (#.Primitive name paramsT+'))) - (^or #;Void #;Unit (#;Bound _) (#;Ex _) (#;Named _)) + (^or #.Void #.Unit (#.Bound _) (#.Ex _) (#.Named _)) (:: Monad<Check> wrap inputT) (^template [<tag>] @@ -655,13 +655,13 @@ [leftT' (clean leftT) rightT' (clean rightT)] (wrap (<tag> leftT' rightT')))) - ([#;Sum] [#;Product] [#;Function] [#;Apply]) + ([#.Sum] [#.Product] [#.Function] [#.Apply]) - (#;Var id) + (#.Var id) (do Monad<Check> [?actualT (read id)] (case ?actualT - (#;Some actualT) + (#.Some actualT) (clean actualT) _ @@ -670,7 +670,7 @@ (^template [<tag>] (<tag> envT+ unquantifiedT) (do Monad<Check> - [envT+' (monad;map @ clean envT+)] + [envT+' (monad.map @ clean envT+)] (wrap (<tag> envT+' unquantifiedT)))) - ([#;UnivQ] [#;ExQ]) + ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index dcf509e65..0b28598c8 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Functions for extracting information from the state of the compiler."} +(.module: {#.doc "Functions for extracting information from the state of the compiler."} lux (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -13,38 +13,38 @@ (/ [code])) ## (type: (Meta a) -## (-> Compiler (e;Error [Compiler a]))) +## (-> Compiler (e.Error [Compiler a]))) (struct: #export _ (Functor Meta) (def: (map f fa) (function [compiler] (case (fa compiler) - (#e;Error msg) - (#e;Error msg) + (#e.Error msg) + (#e.Error msg) - (#e;Success [compiler' a]) - (#e;Success [compiler' (f a)]))))) + (#e.Success [compiler' a]) + (#e.Success [compiler' (f a)]))))) (struct: #export _ (Applicative Meta) (def: functor Functor<Meta>) (def: (wrap x) (function [compiler] - (#e;Success [compiler x]))) + (#e.Success [compiler x]))) (def: (apply ff fa) (function [compiler] (case (ff compiler) - (#e;Success [compiler' f]) + (#e.Success [compiler' f]) (case (fa compiler') - (#e;Success [compiler'' a]) - (#e;Success [compiler'' (f a)]) + (#e.Success [compiler'' a]) + (#e.Success [compiler'' (f a)]) - (#e;Error msg) - (#e;Error msg)) + (#e.Error msg) + (#e.Error msg)) - (#e;Error msg) - (#e;Error msg))))) + (#e.Error msg) + (#e.Error msg))))) (struct: #export _ (Monad Meta) (def: applicative Applicative<Meta>) @@ -52,82 +52,82 @@ (def: (join mma) (function [compiler] (case (mma compiler) - (#e;Error msg) - (#e;Error msg) + (#e.Error msg) + (#e.Error msg) - (#e;Success [compiler' ma]) + (#e.Success [compiler' ma]) (ma compiler'))))) (def: (get k plist) (All [a] (-> Text (List [Text a]) (Maybe a))) (case plist - #;Nil - #;None + #.Nil + #.None - (#;Cons [k' v] plist') + (#.Cons [k' v] plist') (if (text/= k k') - (#;Some v) + (#.Some v) (get k plist')))) (def: #export (run' compiler action) - (All [a] (-> Compiler (Meta a) (e;Error [Compiler a]))) + (All [a] (-> Compiler (Meta a) (e.Error [Compiler a]))) (action compiler)) (def: #export (run compiler action) - (All [a] (-> Compiler (Meta a) (e;Error a))) + (All [a] (-> Compiler (Meta a) (e.Error a))) (case (action compiler) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success [_ output]) - (#e;Success output))) + (#e.Success [_ output]) + (#e.Success output))) (def: #export (either left right) - {#;doc "Pick whichever computation succeeds."} + {#.doc "Pick whichever computation succeeds."} (All [a] (-> (Meta a) (Meta a) (Meta a))) (function [compiler] (case (left compiler) - (#e;Error error) + (#e.Error error) (right compiler) - (#e;Success [compiler' output]) - (#e;Success [compiler' output])))) + (#e.Success [compiler' output]) + (#e.Success [compiler' output])))) (def: #export (assert message test) - {#;doc "Fails with the given message if the test is false."} + {#.doc "Fails with the given message if the test is false."} (-> Text Bool (Meta Unit)) (function [compiler] (if test - (#e;Success [compiler []]) - (#e;Error message)))) + (#e.Success [compiler []]) + (#e.Error message)))) (def: #export (fail msg) - {#;doc "Fails with the given message."} + {#.doc "Fails with the given message."} (All [a] (-> Text (Meta a))) (function [_] - (#e;Error msg))) + (#e.Error msg))) (def: #export (find-module name) (-> Text (Meta Module)) (function [compiler] - (case (get name (get@ #;modules compiler)) - (#;Some module) - (#e;Success [compiler module]) + (case (get name (get@ #.modules compiler)) + (#.Some module) + (#e.Success [compiler module]) _ - (#e;Error ($_ text/compose "Unknown module: " name))))) + (#e.Error ($_ text/compose "Unknown module: " name))))) (def: #export current-module-name (Meta Text) (function [compiler] - (case (get@ #;current-module compiler) - (#;Some current-module) - (#e;Success [compiler current-module]) + (case (get@ #.current-module compiler) + (#.Some current-module) + (#e.Success [compiler current-module]) _ - (#e;Error "No current module.") + (#e.Error "No current module.") ))) (def: #export current-module @@ -137,81 +137,81 @@ (find-module this-module-name))) (def: #export (get-ann tag anns) - {#;doc "Looks-up a particular annotation's value within the set of annotations."} + {#.doc "Looks-up a particular annotation's value within the set of annotations."} (-> Ident Code (Maybe Code)) (case anns - [_ (#;Record anns)] + [_ (#.Record anns)] (loop [anns anns] (case anns - (#;Cons [key value] anns') + (#.Cons [key value] anns') (case key - [_ (#;Tag tag')] + [_ (#.Tag tag')] (if (ident/= tag tag') - (#;Some value) + (#.Some value) (recur anns')) _ (recur anns')) - #;Nil - #;None)) + #.Nil + #.None)) _ - #;None)) + #.None)) (do-template [<name> <tag> <type>] [(def: #export (<name> tag anns) (-> Ident Code (Maybe <type>)) (case (get-ann tag anns) - (#;Some [_ (<tag> value)]) - (#;Some value) + (#.Some [_ (<tag> value)]) + (#.Some value) _ - #;None))] - - [get-bool-ann #;Bool Bool] - [get-int-ann #;Int Int] - [get-frac-ann #;Frac Frac] - [get-text-ann #;Text Text] - [get-symbol-ann #;Symbol Ident] - [get-tag-ann #;Tag Ident] - [get-form-ann #;Form (List Code)] - [get-tuple-ann #;Tuple (List Code)] - [get-record-ann #;Record (List [Code Code])] + #.None))] + + [get-bool-ann #.Bool Bool] + [get-int-ann #.Int Int] + [get-frac-ann #.Frac Frac] + [get-text-ann #.Text Text] + [get-symbol-ann #.Symbol Ident] + [get-tag-ann #.Tag Ident] + [get-form-ann #.Form (List Code)] + [get-tuple-ann #.Tuple (List Code)] + [get-record-ann #.Record (List [Code Code])] ) (def: #export (get-doc anns) - {#;doc "Looks-up a definition's documentation."} + {#.doc "Looks-up a definition's documentation."} (-> Code (Maybe Text)) - (get-text-ann (ident-for #;doc) anns)) + (get-text-ann (ident-for #.doc) anns)) (def: #export (flag-set? flag-name anns) - {#;doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."} + {#.doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."} (-> Ident Code Bool) - (maybe;default false (get-bool-ann flag-name anns))) + (maybe.default false (get-bool-ann flag-name anns))) (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (code;text ($_ text/compose "Checks whether a definition is " <desc> "."))} + {#.doc (code.text ($_ text/compose "Checks whether a definition is " <desc> "."))} (-> Code Bool) (flag-set? (ident-for <tag>)))] - [export? #;export? "exported"] - [hidden? #;hidden? "hidden"] - [macro? #;macro? "a macro"] - [type? #;type? "a type"] - [struct? #;struct? "a structure"] - [type-rec? #;type-rec? "a recursive type"] - [sig? #;sig? "a signature"] + [export? #.export? "exported"] + [hidden? #.hidden? "hidden"] + [macro? #.macro? "a macro"] + [type? #.type? "a type"] + [struct? #.struct? "a structure"] + [type-rec? #.type-rec? "a recursive type"] + [sig? #.sig? "a signature"] ) (def: #export (aliased? annotations) (-> Code Bool) - (case (get-symbol-ann (ident-for #;alias) annotations) - (#;Some _) + (case (get-symbol-ann (ident-for #.alias) annotations) + (#.Some _) true - #;None + #.None false)) (do-template [<name> <tag> <type>] @@ -219,48 +219,48 @@ (-> Code (Maybe <type>)) (case input [_ (<tag> actual-value)] - (#;Some actual-value) + (#.Some actual-value) _ - #;None))] + #.None))] - [parse-tuple #;Tuple (List Code)] - [parse-text #;Text Text] + [parse-tuple #.Tuple (List Code)] + [parse-text #.Text Text] ) (do-template [<name> <tag> <desc>] [(def: #export (<name> anns) - {#;doc <desc>} + {#.doc <desc>} (-> Code (List Text)) - (maybe;default (list) - (do maybe;Monad<Maybe> + (maybe.default (list) + (do maybe.Monad<Maybe> [_args (get-ann (ident-for <tag>) anns) args (parse-tuple _args)] - (monad;map @ parse-text args))))] + (monad.map @ parse-text args))))] - [func-args #;func-args "Looks up the arguments of a function."] - [type-args #;type-args "Looks up the arguments of a parameterized type."] - [declared-tags #;tags "Looks up the tags of a tagged (variant or record) type."] + [func-args #.func-args "Looks up the arguments of a function."] + [type-args #.type-args "Looks up the arguments of a parameterized type."] + [declared-tags #.tags "Looks up the tags of a tagged (variant or record) type."] ) (def: (find-macro' modules this-module module name) (-> (List [Text Module]) Text Text Text (Maybe Macro)) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [$module (get module modules) - [def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #;defs) (get name)))] + [def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #.defs) (get name)))] (if (and (macro? def-anns) (or (export? def-anns) (text/= module this-module))) - (#;Some (:! Macro def-value)) - (case (get-symbol-ann (ident-for #;alias) def-anns) - (#;Some [r-module r-name]) + (#.Some (:! Macro def-value)) + (case (get-symbol-ann (ident-for #.alias) def-anns) + (#.Some [r-module r-name]) (find-macro' modules this-module r-module r-name) _ - #;None)))) + #.None)))) (def: #export (normalize ident) - {#;doc "If given an identifier without a module prefix, gives it the current module's name as prefix. + {#.doc "If given an identifier without a module prefix, gives it the current module's name as prefix. Otherwise, returns the identifier as-is."} (-> Ident (Meta Ident)) @@ -281,116 +281,116 @@ (let [[module name] ident] (: (Meta (Maybe Macro)) (function [compiler] - (#e;Success [compiler (find-macro' (get@ #;modules compiler) this-module module name)])))))) + (#e.Success [compiler (find-macro' (get@ #.modules compiler) this-module module name)])))))) (def: #export (expand-once syntax) - {#;doc "Given code that requires applying a macro, does it once and returns the result. + {#.doc "Given code that requires applying a macro, does it once and returns the result. Otherwise, returns the code as-is."} (-> Code (Meta (List Code))) (case syntax - [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] + [_ (#.Form (#.Cons [[_ (#.Symbol name)] args]))] (do Monad<Meta> [?macro (find-macro name)] (case ?macro - (#;Some macro) + (#.Some macro) (macro args) - #;None + #.None (:: Monad<Meta> wrap (list syntax)))) _ (:: Monad<Meta> wrap (list syntax)))) (def: #export (expand syntax) - {#;doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left. + {#.doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left. Otherwise, returns the code as-is."} (-> Code (Meta (List Code))) (case syntax - [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] + [_ (#.Form (#.Cons [[_ (#.Symbol name)] args]))] (do Monad<Meta> [?macro (find-macro name)] (case ?macro - (#;Some macro) + (#.Some macro) (do Monad<Meta> [expansion (macro args) - expansion' (monad;map Monad<Meta> expand expansion)] + expansion' (monad.map Monad<Meta> expand expansion)] (wrap (list/join expansion'))) - #;None + #.None (:: Monad<Meta> wrap (list syntax)))) _ (:: Monad<Meta> wrap (list syntax)))) (def: #export (expand-all syntax) - {#;doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."} + {#.doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."} (-> Code (Meta (List Code))) (case syntax - [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] + [_ (#.Form (#.Cons [[_ (#.Symbol name)] args]))] (do Monad<Meta> [?macro (find-macro name)] (case ?macro - (#;Some macro) + (#.Some macro) (do Monad<Meta> [expansion (macro args) - expansion' (monad;map Monad<Meta> expand-all expansion)] + expansion' (monad.map Monad<Meta> expand-all expansion)] (wrap (list/join expansion'))) - #;None + #.None (do Monad<Meta> - [parts' (monad;map Monad<Meta> expand-all (list& (code;symbol name) args))] - (wrap (list (code;form (list/join parts'))))))) + [parts' (monad.map Monad<Meta> expand-all (list& (code.symbol name) args))] + (wrap (list (code.form (list/join parts'))))))) - [_ (#;Form (#;Cons [harg targs]))] + [_ (#.Form (#.Cons [harg targs]))] (do Monad<Meta> [harg+ (expand-all harg) - targs+ (monad;map Monad<Meta> expand-all targs)] - (wrap (list (code;form (list/compose harg+ (list/join (: (List (List Code)) targs+))))))) + targs+ (monad.map Monad<Meta> expand-all targs)] + (wrap (list (code.form (list/compose harg+ (list/join (: (List (List Code)) targs+))))))) - [_ (#;Tuple members)] + [_ (#.Tuple members)] (do Monad<Meta> - [members' (monad;map Monad<Meta> expand-all members)] - (wrap (list (code;tuple (list/join members'))))) + [members' (monad.map Monad<Meta> expand-all members)] + (wrap (list (code.tuple (list/join members'))))) _ (:: Monad<Meta> wrap (list syntax)))) (def: #export (gensym prefix) - {#;doc "Generates a unique identifier as an Code node (ready to be used in code templates). + {#.doc "Generates a unique identifier as an Code node (ready to be used in code templates). A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} (-> Text (Meta Code)) (function [compiler] - (#e;Success [(update@ #;seed n/inc compiler) - (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed compiler)))])]))) + (#e.Success [(update@ #.seed n/inc compiler) + (code.symbol ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))])]))) (def: (get-local-symbol ast) (-> Code (Meta Text)) (case ast - [_ (#;Symbol [_ name])] + [_ (#.Symbol [_ name])] (:: Monad<Meta> wrap name) _ - (fail (text/compose "Code is not a local symbol: " (code;to-text ast))))) + (fail (text/compose "Code is not a local symbol: " (code.to-text ast))))) (macro: #export (with-gensyms tokens) - {#;doc (doc "Creates new symbols and offers them to the body expression." + {#.doc (doc "Creates new symbols and offers them to the body expression." (syntax: #export (synchronized lock body) (with-gensyms [g!lock g!body g!_] (wrap (list (` (let [(~ g!lock) (~ lock) - (~ g!_) (;_jvm_monitorenter (~ g!lock)) + (~ g!_) ("jvm monitorenter" (~ g!lock)) (~ g!body) (~ body) - (~ g!_) (;_jvm_monitorexit (~ g!lock))] + (~ g!_) ("jvm monitorexit" (~ g!lock))] (~ g!body))))) )))} (case tokens - (^ (list [_ (#;Tuple symbols)] body)) + (^ (list [_ (#.Tuple symbols)] body)) (do Monad<Meta> - [symbol-names (monad;map @ get-local-symbol symbols) + [symbol-names (monad.map @ get-local-symbol symbols) #let [symbol-defs (list/join (list/map (: (-> Text (List Code)) - (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) + (function [name] (list (code.symbol ["" name]) (` (gensym (~ (code.text name))))))) symbol-names))]] (wrap (list (` (do Monad<Meta> [(~@ symbol-defs)] @@ -400,7 +400,7 @@ (fail "Wrong syntax for with-gensyms"))) (def: #export (expand-1 token) - {#;doc "Works just like expand, except that it ensures that the output is a single Code token."} + {#.doc "Works just like expand, except that it ensures that the output is a single Code token."} (-> Code (Meta Code)) (do Monad<Meta> [token+ (expand token)] @@ -414,83 +414,83 @@ (def: #export (module-exists? module) (-> Text (Meta Bool)) (function [compiler] - (#e;Success [compiler (case (get module (get@ #;modules compiler)) - (#;Some _) + (#e.Success [compiler (case (get module (get@ #.modules compiler)) + (#.Some _) true - #;None + #.None false)]))) (def: (try-both f x1 x2) (All [a b] (-> (-> a (Maybe b)) a a (Maybe b))) (case (f x1) - #;None (f x2) - (#;Some y) (#;Some y))) + #.None (f x2) + (#.Some y) (#.Some y))) (def: #export (find-var-type name) - {#;doc "Looks-up the type of a local variable somewhere in the environment."} + {#.doc "Looks-up the type of a local variable somewhere in the environment."} (-> Text (Meta Type)) (function [compiler] (let [test (: (-> [Text [Type Top]] Bool) - (|>> product;left (text/= name)))] - (case (do maybe;Monad<Maybe> - [scope (list;find (function [env] - (or (list;any? test (: (List [Text [Type Top]]) - (get@ [#;locals #;mappings] env))) - (list;any? test (: (List [Text [Type Top]]) - (get@ [#;captured #;mappings] env))))) - (get@ #;scopes compiler)) - [_ [type _]] (try-both (list;find test) + (|>> product.left (text/= name)))] + (case (do maybe.Monad<Maybe> + [scope (list.find (function [env] + (or (list.any? test (: (List [Text [Type Top]]) + (get@ [#.locals #.mappings] env))) + (list.any? test (: (List [Text [Type Top]]) + (get@ [#.captured #.mappings] env))))) + (get@ #.scopes compiler)) + [_ [type _]] (try-both (list.find test) (: (List [Text [Type Top]]) - (get@ [#;locals #;mappings] scope)) + (get@ [#.locals #.mappings] scope)) (: (List [Text [Type Top]]) - (get@ [#;captured #;mappings] scope)))] + (get@ [#.captured #.mappings] scope)))] (wrap type)) - (#;Some var-type) - (#e;Success [compiler var-type]) + (#.Some var-type) + (#e.Success [compiler var-type]) - #;None - (#e;Error ($_ text/compose "Unknown variable: " name)))))) + #.None + (#e.Error ($_ text/compose "Unknown variable: " name)))))) (def: #export (find-def name) - {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."} + {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} (-> Ident (Meta Def)) (do Monad<Meta> [name (normalize name)] (function [compiler] (case (: (Maybe Def) - (do maybe;Monad<Maybe> + (do maybe.Monad<Maybe> [#let [[v-prefix v-name] name] - (^slots [#;defs]) (get v-prefix (get@ #;modules compiler))] + (^slots [#.defs]) (get v-prefix (get@ #.modules compiler))] (get v-name defs))) - (#;Some definition) - (#e;Success [compiler definition]) + (#.Some definition) + (#e.Success [compiler definition]) _ - (let [current-module (|> compiler (get@ #;current-module) (maybe;default "???"))] - (#e;Error ($_ text/compose + (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???"))] + (#e.Error ($_ text/compose "Unknown definition: " (ident/encode name) "\n" " Current module: " current-module "\n" - (case (get current-module (get@ #;modules compiler)) - (#;Some this-module) + (case (get current-module (get@ #.modules compiler)) + (#.Some this-module) ($_ text/compose - " Imports: " (|> this-module (get@ #;imports) (text;join-with ", ")) "\n" - " Aliases: " (|> this-module (get@ #;module-aliases) (list/map (function [[alias real]] ($_ text/compose alias " => " real))) (text;join-with ", ")) "\n") + " Imports: " (|> this-module (get@ #.imports) (text.join-with ", ")) "\n" + " Aliases: " (|> this-module (get@ #.module-aliases) (list/map (function [[alias real]] ($_ text/compose alias " => " real))) (text.join-with ", ")) "\n") _ "") - " All Known modules: " (|> compiler (get@ #;modules) (list/map product;left) (text;join-with ", ")) "\n"))))))) + " All Known modules: " (|> compiler (get@ #.modules) (list/map product.left) (text.join-with ", ")) "\n"))))))) (def: #export (find-def-type name) - {#;doc "Looks-up a definition's type in the available modules (including the current one)."} + {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Ident (Meta Type)) (do Monad<Meta> [[def-type def-data def-value] (find-def name)] (wrap def-type))) (def: #export (find-type name) - {#;doc "Looks-up the type of either a local variable or a definition."} + {#.doc "Looks-up the type of either a local variable or a definition."} (-> Ident (Meta Type)) (do Monad<Meta> [#let [[_ _name] name]] @@ -503,86 +503,86 @@ (find-def-type name)))) (def: #export (find-type-def name) - {#;doc "Finds the value of a type definition (such as Int, Top or Compiler)."} + {#.doc "Finds the value of a type definition (such as Int, Top or Compiler)."} (-> Ident (Meta Type)) (do Monad<Meta> [[def-type def-data def-value] (find-def name)] (wrap (:! Type def-value)))) (def: #export (defs module-name) - {#;doc "The entire list of definitions in a module (including the unexported/private ones)."} + {#.doc "The entire list of definitions in a module (including the unexported/private ones)."} (-> Text (Meta (List [Text Def]))) (function [compiler] - (case (get module-name (get@ #;modules compiler)) - #;None (#e;Error ($_ text/compose "Unknown module: " module-name)) - (#;Some module) (#e;Success [compiler (get@ #;defs module)]) + (case (get module-name (get@ #.modules compiler)) + #.None (#e.Error ($_ text/compose "Unknown module: " module-name)) + (#.Some module) (#e.Success [compiler (get@ #.defs module)]) ))) (def: #export (exports module-name) - {#;doc "All the exported definitions in a module."} + {#.doc "All the exported definitions in a module."} (-> Text (Meta (List [Text Def]))) (do Monad<Meta> [defs (defs module-name)] - (wrap (list;filter (function [[name [def-type def-anns def-value]]] + (wrap (list.filter (function [[name [def-type def-anns def-value]]] (and (export? def-anns) (not (hidden? def-anns)))) defs)))) (def: #export modules - {#;doc "All the available modules (including the current one)."} + {#.doc "All the available modules (including the current one)."} (Meta (List [Text Module])) (function [compiler] (|> compiler - (get@ #;modules) + (get@ #.modules) [compiler] - #e;Success))) + #e.Success))) (def: #export (tags-of type-name) - {#;doc "All the tags associated with a type definition."} + {#.doc "All the tags associated with a type definition."} (-> Ident (Meta (Maybe (List Ident)))) (do Monad<Meta> [#let [[module name] type-name] module (find-module module)] - (case (get name (get@ #;types module)) - (#;Some [tags _]) - (wrap (#;Some tags)) + (case (get name (get@ #.types module)) + (#.Some [tags _]) + (wrap (#.Some tags)) _ - (wrap #;None)))) + (wrap #.None)))) (def: #export cursor - {#;doc "The cursor of the current expression being analyzed."} + {#.doc "The cursor of the current expression being analyzed."} (Meta Cursor) (function [compiler] - (#e;Success [compiler (get@ #;cursor compiler)]))) + (#e.Success [compiler (get@ #.cursor compiler)]))) (def: #export expected-type - {#;doc "The expected type of the current expression being analyzed."} + {#.doc "The expected type of the current expression being analyzed."} (Meta Type) (function [compiler] - (case (get@ #;expected compiler) - (#;Some type) - (#e;Success [compiler type]) + (case (get@ #.expected compiler) + (#.Some type) + (#e.Success [compiler type]) - #;None - (#e;Error "Not expecting any type.")))) + #.None + (#e.Error "Not expecting any type.")))) (def: #export (imported-modules module-name) - {#;doc "All the modules imported by a specified module."} + {#.doc "All the modules imported by a specified module."} (-> Text (Meta (List Text))) (do Monad<Meta> - [(^slots [#;imports]) (find-module module-name)] + [(^slots [#.imports]) (find-module module-name)] (wrap imports))) (def: #export (resolve-tag tag) - {#;doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."} + {#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."} (-> Ident (Meta [Nat (List Ident) Type])) (do Monad<Meta> [#let [[module name] tag] =module (find-module module) this-module-name current-module-name] - (case (get name (get@ #;tags =module)) - (#;Some [idx tag-list exported? type]) + (case (get name (get@ #.tags =module)) + (#.Some [idx tag-list exported? type]) (if (or exported? (text/= this-module-name module)) (wrap [idx tag-list type]) @@ -592,78 +592,78 @@ (fail ($_ text/compose "Unknown tag: " (ident/encode tag)))))) (def: #export (tag-lists module) - {#;doc "All the tag-lists defined in a module, with their associated types."} + {#.doc "All the tag-lists defined in a module, with their associated types."} (-> Text (Meta (List [(List Ident) Type]))) (do Monad<Meta> [=module (find-module module) this-module-name current-module-name] - (wrap (|> (get@ #;types =module) - (list;filter (function [[type-name [tag-list exported? type]]] + (wrap (|> (get@ #.types =module) + (list.filter (function [[type-name [tag-list exported? type]]] (or exported? (text/= this-module-name module)))) (list/map (function [[type-name [tag-list exported? type]]] [tag-list type])))))) (def: #export locals - {#;doc "All the local variables currently in scope, separated in different scopes."} + {#.doc "All the local variables currently in scope, separated in different scopes."} (Meta (List (List [Text Type]))) (function [compiler] - (case (list;inits (get@ #;scopes compiler)) - #;None - (#e;Error "No local environment") + (case (list.inits (get@ #.scopes compiler)) + #.None + (#e.Error "No local environment") - (#;Some scopes) - (#e;Success [compiler - (list/map (|>> (get@ [#;locals #;mappings]) + (#.Some scopes) + (#e.Success [compiler + (list/map (|>> (get@ [#.locals #.mappings]) (list/map (function [[name [type _]]] [name type]))) scopes)])))) (def: #export (un-alias def-name) - {#;doc "Given an aliased definition's name, returns the original definition being referenced."} + {#.doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Ident (Meta Ident)) (do Monad<Meta> [[_ def-anns _] (find-def def-name)] - (case (get-symbol-ann (ident-for #;alias) def-anns) - (#;Some real-def-name) + (case (get-symbol-ann (ident-for #.alias) def-anns) + (#.Some real-def-name) (wrap real-def-name) _ (wrap def-name)))) (def: #export get-compiler - {#;doc "Obtains the current state of the compiler."} + {#.doc "Obtains the current state of the compiler."} (Meta Compiler) (function [compiler] - (#e;Success [compiler compiler]))) + (#e.Success [compiler compiler]))) (def: #export type-context (Meta Type-Context) (function [compiler] - (#e;Success [compiler (get@ #;type-context compiler)]))) + (#e.Success [compiler (get@ #.type-context compiler)]))) (do-template [<macro> <func> <desc>] [(macro: #export (<macro> tokens) - {#;doc (doc "Performs a macro-expansion and logs the resulting code." + {#.doc (doc "Performs a macro-expansion and logs the resulting code." "You can either use the resulting code, or omit them." - "By omitting them, this macro produces nothing (just like the lux;comment macro)." + "By omitting them, this macro produces nothing (just like the lux.comment macro)." (<macro> #omit (def: (foo bar baz) (-> Int Int Int) (i/+ bar baz))))} (case tokens - (^ (list [_ (#;Tag ["" "omit"])] + (^ (list [_ (#.Tag ["" "omit"])] token)) (do Monad<Meta> [output (<func> token) - #let [_ (list/map (|>> code;to-text log!) + #let [_ (list/map (|>> code.to-text log!) output)]] (wrap (list))) (^ (list token)) (do Monad<Meta> [output (<func> token) - #let [_ (list/map (|>> code;to-text log!) + #let [_ (list/map (|>> code.to-text log!) output)]] (wrap output)) diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index d41dbe240..73b6bbf5a 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [eq #+ Eq]) (data bool @@ -10,16 +10,16 @@ ## [Types] ## (type: (Code' w) -## (#;Bool Bool) -## (#;Nat Nat) -## (#;Int Int) -## (#;Frac Frac) -## (#;Text Text) -## (#;Symbol Text Text) -## (#;Tag Text Text) -## (#;Form (List (w (Code' w)))) -## (#;Tuple (List (w (Code' w)))) -## (#;Record (List [(w (Code' w)) (w (Code' w))]))) +## (#.Bool Bool) +## (#.Nat Nat) +## (#.Int Int) +## (#.Frac Frac) +## (#.Text Text) +## (#.Symbol Text Text) +## (#.Tag Text Text) +## (#.Form (List (w (Code' w)))) +## (#.Tuple (List (w (Code' w)))) +## (#.Record (List [(w (Code' w)) (w (Code' w))]))) ## (type: Code ## (Ann Cursor (Code' (Ann Cursor)))) @@ -33,27 +33,27 @@ (-> <type> Code) [_cursor (<tag> x)])] - [bool Bool #;Bool] - [nat Nat #;Nat] - [int Int #;Int] - [deg Deg #;Deg] - [frac Frac #;Frac] - [text Text #;Text] - [symbol Ident #;Symbol] - [tag Ident #;Tag] - [form (List Code) #;Form] - [tuple (List Code) #;Tuple] - [record (List [Code Code]) #;Record] + [bool Bool #.Bool] + [nat Nat #.Nat] + [int Int #.Int] + [deg Deg #.Deg] + [frac Frac #.Frac] + [text Text #.Text] + [symbol Ident #.Symbol] + [tag Ident #.Tag] + [form (List Code) #.Form] + [tuple (List Code) #.Tuple] + [record (List [Code Code]) #.Record] ) (do-template [<name> <tag> <doc>] [(def: #export (<name> name) - {#;doc <doc>} + {#.doc <doc>} (-> Text Code) [_cursor (<tag> ["" name])])] - [local-symbol #;Symbol "Produces a local symbol (a symbol with no module prefix)."] - [local-tag #;Tag "Produces a local tag (a tag with no module prefix)."]) + [local-symbol #.Symbol "Produces a local symbol (a symbol with no module prefix)."] + [local-tag #.Tag "Produces a local tag (a tag with no module prefix)."]) ## [Structures] (struct: #export _ (Eq Code) @@ -62,14 +62,14 @@ (^template [<tag> <eq>] [[_ (<tag> x')] [_ (<tag> y')]] (:: <eq> = x' y')) - ([#;Bool Eq<Bool>] - [#;Nat Eq<Nat>] - [#;Int Eq<Int>] - [#;Deg Eq<Deg>] - [#;Frac Eq<Frac>] - [#;Text Eq<Text>] - [#;Symbol Eq<Ident>] - [#;Tag Eq<Ident>]) + ([#.Bool Eq<Bool>] + [#.Nat Eq<Nat>] + [#.Int Eq<Int>] + [#.Deg Eq<Deg>] + [#.Frac Eq<Frac>] + [#.Text Eq<Text>] + [#.Symbol Eq<Ident>] + [#.Tag Eq<Ident>]) (^template [<tag>] [[_ (<tag> xs')] [_ (<tag> ys')]] @@ -78,10 +78,10 @@ (and old (= x' y'))) true (zip2 xs' ys')))) - ([#;Form] - [#;Tuple]) + ([#.Form] + [#.Tuple]) - [[_ (#;Record xs')] [_ (#;Record ys')]] + [[_ (#.Record xs')] [_ (#.Record ys')]] (and (:: Eq<Nat> = (size xs') (size ys')) (fold (function [[[xl' xr'] [yl' yr']] old] (and old (= xl' yl') (= xr' yr'))) @@ -98,31 +98,31 @@ (^template [<tag> <struct>] [_ (<tag> value)] (:: <struct> encode value)) - ([#;Bool Codec<Text,Bool>] - [#;Nat Codec<Text,Nat>] - [#;Int Codec<Text,Int>] - [#;Deg Codec<Text,Deg>] - [#;Frac Codec<Text,Frac>] - [#;Symbol Codec<Text,Ident>]) + ([#.Bool Codec<Text,Bool>] + [#.Nat Codec<Text,Nat>] + [#.Int Codec<Text,Int>] + [#.Deg Codec<Text,Deg>] + [#.Frac Codec<Text,Frac>] + [#.Symbol Codec<Text,Ident>]) - [_ (#;Text value)] - (text;encode value) + [_ (#.Text value)] + (text.encode value) - [_ (#;Tag ident)] + [_ (#.Tag ident)] (Text/compose "#" (:: Codec<Text,Ident> encode ident)) (^template [<tag> <open> <close>] [_ (<tag> members)] - ($_ Text/compose <open> (|> members (map to-text) (interpose " ") (text;join-with "")) <close>)) - ([#;Form "(" ")"] - [#;Tuple "[" "]"]) + ($_ Text/compose <open> (|> members (map to-text) (interpose " ") (text.join-with "")) <close>)) + ([#.Form "(" ")"] + [#.Tuple "[" "]"]) - [_ (#;Record pairs)] - ($_ Text/compose "{" (|> pairs (map (function [[left right]] ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text;join-with "")) "}") + [_ (#.Record pairs)] + ($_ Text/compose "{" (|> pairs (map (function [[left right]] ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text.join-with "")) "}") )) (def: #export (replace original substitute ast) - {#;doc "Replaces all code that looks like the 'original' with the 'substitute'."} + {#.doc "Replaces all code that looks like the 'original' with the 'substitute'."} (-> Code Code Code Code) (if (:: Eq<Code> = original ast) substitute @@ -130,11 +130,11 @@ (^template [<tag>] [cursor (<tag> parts)] [cursor (<tag> (map (replace original substitute) parts))]) - ([#;Form] - [#;Tuple]) + ([#.Form] + [#.Tuple]) - [cursor (#;Record parts)] - [cursor (#;Record (map (function [[left right]] + [cursor (#.Record parts)] + [cursor (#.Record (map (function [[left right]] [(replace original substitute left) (replace original substitute right)]) parts))] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 994c719de..05a609e1b 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,4 +1,4 @@ -(;module: +(.module: [lux #- function] (lux (control [monad #+ do Monad] [eq] @@ -26,121 +26,121 @@ (type: #export Env (Dict Nat [Type Code])) (type: #export (Poly a) - (p;Parser [Env (List Type)] a)) + (p.Parser [Env (List Type)] a)) -(def: #export fresh Env (dict;new number;Hash<Nat>)) +(def: #export fresh Env (dict.new number.Hash<Nat>)) (def: (run' env types poly) - (All [a] (-> Env (List Type) (Poly a) (e;Error a))) - (case (p;run [env types] poly) - (#e;Error error) - (#e;Error error) + (All [a] (-> Env (List Type) (Poly a) (e.Error a))) + (case (p.run [env types] poly) + (#e.Error error) + (#e.Error error) - (#e;Success [[env' remaining] output]) + (#e.Success [[env' remaining] output]) (case remaining - #;Nil - (#e;Success output) + #.Nil + (#e.Success output) _ - (#e;Error (|> remaining - (list/map type;to-text) - (text;join-with ", ") + (#e.Error (|> remaining + (list/map type.to-text) + (text.join-with ", ") (text/compose "Unconsumed types: ")))))) (def: #export (run type poly) - (All [a] (-> Type (Poly a) (e;Error a))) + (All [a] (-> Type (Poly a) (e.Error a))) (run' fresh (list type) poly)) (def: #export env (Poly Env) - (;function [[env inputs]] - (#e;Success [[env inputs] env]))) + (.function [[env inputs]] + (#e.Success [[env inputs] env]))) (def: (with-env temp poly) (All [a] (-> Env (Poly a) (Poly a))) - (;function [[env inputs]] - (case (p;run [temp inputs] poly) - (#e;Error error) - (#e;Error error) + (.function [[env inputs]] + (case (p.run [temp inputs] poly) + (#e.Error error) + (#e.Error error) - (#e;Success [[_ remaining] output]) - (#e;Success [[env remaining] output])))) + (#e.Success [[_ remaining] output]) + (#e.Success [[env remaining] output])))) (def: #export peek (Poly Type) - (;function [[env inputs]] + (.function [[env inputs]] (case inputs - #;Nil - (#e;Error "Empty stream of types.") + #.Nil + (#e.Error "Empty stream of types.") - (#;Cons headT tail) - (#e;Success [[env inputs] headT])))) + (#.Cons headT tail) + (#e.Success [[env inputs] headT])))) (def: #export any (Poly Type) - (;function [[env inputs]] + (.function [[env inputs]] (case inputs - #;Nil - (#e;Error "Empty stream of types.") + #.Nil + (#e.Error "Empty stream of types.") - (#;Cons headT tail) - (#e;Success [[env tail] headT])))) + (#.Cons headT tail) + (#e.Success [[env tail] headT])))) (def: #export (local types poly) (All [a] (-> (List Type) (Poly a) (Poly a))) - (;function [[env pass-through]] + (.function [[env pass-through]] (case (run' env types poly) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success output) - (#e;Success [[env pass-through] output])))) + (#e.Success output) + (#e.Success [[env pass-through] output])))) (def: (label idx) (-> Nat Code) - (code;local-symbol (text/compose "label\u0000" (nat/encode idx)))) + (code.local-symbol (text/compose "label\u0000" (nat/encode idx)))) (def: #export (with-extension type poly) (All [a] (-> Type (Poly a) (Poly [Code a]))) - (;function [[env inputs]] - (let [current-id (dict;size env) + (.function [[env inputs]] + (let [current-id (dict.size env) g!var (label current-id)] - (case (p;run [(dict;put current-id [type g!var] env) + (case (p.run [(dict.put current-id [type g!var] env) inputs] poly) - (#e;Error error) - (#e;Error error) + (#e.Error error) + (#e.Error error) - (#e;Success [[_ inputs'] output]) - (#e;Success [[env inputs'] [g!var output]]))))) + (#e.Success [[_ inputs'] output]) + (#e.Success [[env inputs'] [g!var output]]))))) (do-template [<combinator> <name> <type>] [(def: #export <combinator> (Poly Unit) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (case (type;un-name headT) + (case (type.un-name headT) <type> (wrap []) _ - (p;fail ($_ text/compose "Not " <name> " type: " (type;to-text headT))))))] - - [void "Void" #;Void] - [unit "Unit" #;Unit] - [bool "Bool" (#;Primitive "#Bool" #;Nil)] - [nat "Nat" (#;Primitive "#Nat" #;Nil)] - [int "Int" (#;Primitive "#Int" #;Nil)] - [deg "Deg" (#;Primitive "#Deg" #;Nil)] - [frac "Frac" (#;Primitive "#Frac" #;Nil)] - [text "Text" (#;Primitive "#Text" #;Nil)] + (p.fail ($_ text/compose "Not " <name> " type: " (type.to-text headT))))))] + + [void "Void" #.Void] + [unit "Unit" #.Unit] + [bool "Bool" (#.Primitive "#Bool" #.Nil)] + [nat "Nat" (#.Primitive "#Nat" #.Nil)] + [int "Int" (#.Primitive "#Int" #.Nil)] + [deg "Deg" (#.Primitive "#Deg" #.Nil)] + [frac "Frac" (#.Primitive "#Frac" #.Nil)] + [text "Text" (#.Primitive "#Text" #.Nil)] ) (def: #export basic (Poly Type) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (case (run headT ($_ p;either + (case (run headT ($_ p.either void unit bool @@ -149,42 +149,42 @@ deg frac text)) - (#e;Error error) - (p;fail error) + (#e.Error error) + (p.fail error) - (#e;Success _) + (#e.Success _) (wrap headT)))) (do-template [<name> <flattener> <tag>] [(def: #export (<name> poly) (All [a] (-> (Poly a) (Poly a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (let [members (<flattener> (type;un-name headT))] - (if (n/> +1 (list;size members)) + (let [members (<flattener> (type.un-name headT))] + (if (n/> +1 (list.size members)) (local members poly) - (p;fail ($_ text/compose "Not a " (ident/encode (ident-for <tag>)) " type: " (type;to-text headT)))))))] + (p.fail ($_ text/compose "Not a " (ident/encode (ident-for <tag>)) " type: " (type.to-text headT)))))))] - [variant type;flatten-variant #;Sum] - [tuple type;flatten-tuple #;Product] + [variant type.flatten-variant #.Sum] + [tuple type.flatten-tuple #.Product] ) (def: polymorphic' (Poly [Nat Type]) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - #let [[num-arg bodyT] (type;flatten-univ-q (type;un-name headT))]] + #let [[num-arg bodyT] (type.flatten-univ-q (type.un-name headT))]] (if (n/= +0 num-arg) - (p;fail ($_ text/compose "Non-polymorphic type: " (type;to-text headT))) + (p.fail ($_ text/compose "Non-polymorphic type: " (type.to-text headT))) (wrap [num-arg bodyT])))) (def: #export (polymorphic poly) (All [a] (-> (Poly a) (Poly [Code (List Code) a]))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - funcI (:: @ map dict;size ;;env) + funcI (:: @ map dict.size ..env) [num-args non-poly] (local (list headT) polymorphic') - env ;;env + env ..env #let [funcL (label funcI) [all-varsL env'] (loop [current-arg +0 env' env @@ -194,20 +194,20 @@ (let [varL (label (n/inc funcI))] (recur (n/inc current-arg) (|> env' - (dict;put funcI [headT funcL]) - (dict;put (n/inc funcI) [(#;Bound (n/inc funcI)) varL])) - (#;Cons varL all-varsL))) + (dict.put funcI [headT funcL]) + (dict.put (n/inc funcI) [(#.Bound (n/inc funcI)) varL])) + (#.Cons varL all-varsL))) (let [partialI (|> current-arg (n/* +2) (n/+ funcI)) partial-varI (n/inc partialI) partial-varL (label partial-varI) - partialC (` ((~ funcL) (~@ (|> (list;n/range +0 (n/dec num-args)) + partialC (` ((~ funcL) (~@ (|> (list.n/range +0 (n/dec num-args)) (list/map (|>> (n/* +2) n/inc (n/+ funcI) label)) - list;reverse))))] + list.reverse))))] (recur (n/inc current-arg) (|> env' - (dict;put partialI [;Void partialC]) - (dict;put partial-varI [(#;Bound partial-varI) partial-varL])) - (#;Cons partial-varL all-varsL)))) + (dict.put partialI [.Void partialC]) + (dict.put partial-varI [(#.Bound partial-varI) partial-varL])) + (#.Cons partial-varL all-varsL)))) [all-varsL env']))]] (|> (do @ [output poly] @@ -217,243 +217,243 @@ (def: #export (function in-poly out-poly) (All [i o] (-> (Poly i) (Poly o) (Poly [i o]))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - #let [[inputsT outputT] (type;flatten-function (type;un-name headT))]] - (if (n/> +0 (list;size inputsT)) - (p;seq (local inputsT in-poly) + #let [[inputsT outputT] (type.flatten-function (type.un-name headT))]] + (if (n/> +0 (list.size inputsT)) + (p.seq (local inputsT in-poly) (local (list outputT) out-poly)) - (p;fail ($_ text/compose "Non-function type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Non-function type: " (type.to-text headT)))))) (def: #export (apply poly) (All [a] (-> (Poly a) (Poly a))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any - #let [[funcT paramsT] (type;flatten-application (type;un-name headT))]] - (if (n/= +0 (list;size paramsT)) - (p;fail ($_ text/compose "Non-application type: " (type;to-text headT))) - (local (#;Cons funcT paramsT) poly)))) + #let [[funcT paramsT] (type.flatten-application (type.un-name headT))]] + (if (n/= +0 (list.size paramsT)) + (p.fail ($_ text/compose "Non-application type: " (type.to-text headT))) + (local (#.Cons funcT paramsT) poly)))) (def: #export (this expected) (-> Type (Poly Unit)) - (do p;Monad<Parser> + (do p.Monad<Parser> [actual any] - (if (check;checks? expected actual) + (if (check.checks? expected actual) (wrap []) - (p;fail ($_ text/compose + (p.fail ($_ text/compose "Types do not match." "\n" - "Expected: " (type;to-text expected) "\n" - " Actual: " (type;to-text actual)))))) + "Expected: " (type.to-text expected) "\n" + " Actual: " (type.to-text actual)))))) (def: (adjusted-idx env idx) (-> Env Nat Nat) - (let [env-level (n// +2 (dict;size env)) + (let [env-level (n// +2 (dict.size env)) bound-level (n// +2 idx) bound-idx (n/% +2 idx)] (|> env-level n/dec (n/- bound-level) (n/* +2) (n/+ bound-idx)))) (def: #export bound (Poly Code) - (do p;Monad<Parser> - [env ;;env + (do p.Monad<Parser> + [env ..env headT any] (case headT - (#;Bound idx) - (case (dict;get (adjusted-idx env idx) env) - (#;Some [poly-type poly-ast]) + (#.Bound idx) + (case (dict.get (adjusted-idx env idx) env) + (#.Some [poly-type poly-ast]) (wrap poly-ast) - #;None - (p;fail ($_ text/compose "Unknown bound type: " (type;to-text headT)))) + #.None + (p.fail ($_ text/compose "Unknown bound type: " (type.to-text headT)))) _ - (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a bound type: " (type.to-text headT)))))) (def: #export (var id) (-> Nat (Poly Unit)) - (do p;Monad<Parser> - [env ;;env + (do p.Monad<Parser> + [env ..env headT any] (case headT - (#;Bound idx) + (#.Bound idx) (if (n/= id (adjusted-idx env idx)) (wrap []) - (p;fail ($_ text/compose "Wrong bound type.\n" + (p.fail ($_ text/compose "Wrong bound type.\n" "Expected: " (nat/encode id) "\n" " Actual: " (nat/encode idx)))) _ - (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a bound type: " (type.to-text headT)))))) (def: #export named (Poly [Ident Type]) - (do p;Monad<Parser> + (do p.Monad<Parser> [inputT any] (case inputT - (#;Named name anonymousT) + (#.Named name anonymousT) (wrap [name anonymousT]) _ - (p;fail ($_ text/compose "Not a named type: " (type;to-text inputT)))))) + (p.fail ($_ text/compose "Not a named type: " (type.to-text inputT)))))) (def: #export (recursive poly) (All [a] (-> (Poly a) (Poly [Code a]))) - (do p;Monad<Parser> + (do p.Monad<Parser> [headT any] - (case (type;un-name headT) - (#;Apply #;Void (#;UnivQ _ headT')) + (case (type.un-name headT) + (#.Apply #.Void (#.UnivQ _ headT')) (do @ [[recT _ output] (|> poly - (with-extension #;Void) + (with-extension #.Void) (with-extension headT) (local (list headT')))] (wrap [recT output])) _ - (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a recursive type: " (type.to-text headT)))))) (def: #export recursive-self (Poly Code) - (do p;Monad<Parser> - [env ;;env + (do p.Monad<Parser> + [env ..env headT any] - (case (type;un-name headT) - (^multi (#;Apply #;Void (#;Bound funcT-idx)) + (case (type.un-name headT) + (^multi (#.Apply #.Void (#.Bound funcT-idx)) (n/= +0 (adjusted-idx env funcT-idx)) - [(dict;get +0 env) (#;Some [self-type self-call])]) + [(dict.get +0 env) (#.Some [self-type self-call])]) (wrap self-call) _ - (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) + (p.fail ($_ text/compose "Not a recursive type: " (type.to-text headT)))))) (def: #export recursive-call (Poly Code) - (do p;Monad<Parser> - [env ;;env - [funcT argsT] (apply (p;seq any (p;many any))) + (do p.Monad<Parser> + [env ..env + [funcT argsT] (apply (p.seq any (p.many any))) _ (local (list funcT) (var +0)) allC (let [allT (list& funcT argsT)] (|> allT - (monad;map @ (function;const bound)) + (monad.map @ (function.const bound)) (local allT)))] (wrap (` ((~@ allC)))))) (def: #export log (All [a] (Poly a)) - (do p;Monad<Parser> + (do p.Monad<Parser> [current any #let [_ (log! ($_ text/compose - "{" (ident/encode (ident-for ;;log)) "} " - (type;to-text current)))]] - (p;fail "LOGGING"))) + "{" (ident/encode (ident-for ..log)) "} " + (type.to-text current)))]] + (p.fail "LOGGING"))) ## [Syntax] -(syntax: #export (poly: [export csr;export] - [name s;local-symbol] +(syntax: #export (poly: [export csr.export] + [name s.local-symbol] body) (with-gensyms [g!type g!output] - (let [g!name (code;symbol ["" name])] - (wrap (;list (` (syntax: (~@ (csw;export export)) ((~ g!name) [(~ g!type) s;symbol]) - (do macro;Monad<Meta> - [(~ g!type) (macro;find-type-def (~ g!type))] + (let [g!name (code.symbol ["" name])] + (wrap (.list (` (syntax: (~@ (csw.export export)) ((~ g!name) [(~ g!type) s.symbol]) + (do macro.Monad<Meta> + [(~ g!type) (macro.find-type-def (~ g!type))] (case (|> (~ body) - (;function [(~ g!name)]) - p;rec - (do p;Monad<Parser> []) - (;;run (~ g!type)) - (: (;Either ;Text ;Code))) - (#;Left (~ g!output)) - (macro;fail (~ g!output)) + (.function [(~ g!name)]) + p.rec + (do p.Monad<Parser> []) + (..run (~ g!type)) + (: (.Either .Text .Code))) + (#.Left (~ g!output)) + (macro.fail (~ g!output)) - (#;Right (~ g!output)) - ((~' wrap) (;list (~ g!output)))))))))))) + (#.Right (~ g!output)) + ((~' wrap) (.list (~ g!output)))))))))))) (def: (common-poly-name? poly-func) (-> Text Bool) - (text;contains? "?" poly-func)) + (text.contains? "?" poly-func)) (def: (derivation-name poly args) (-> Text (List Text) (Maybe Text)) (if (common-poly-name? poly) - (#;Some (list/fold (text;replace-once "?") poly args)) - #;None)) + (#.Some (list/fold (text.replace-once "?") poly args)) + #.None)) -(syntax: #export (derived: [export csr;export] - [?name (p;maybe s;local-symbol)] - [[poly-func poly-args] (s;form (p;seq s;symbol (p;many s;symbol)))] - [?custom-impl (p;maybe s;any)]) +(syntax: #export (derived: [export csr.export] + [?name (p.maybe s.local-symbol)] + [[poly-func poly-args] (s.form (p.seq s.symbol (p.many s.symbol)))] + [?custom-impl (p.maybe s.any)]) (do @ - [poly-args (monad;map @ macro;normalize poly-args) + [poly-args (monad.map @ macro.normalize poly-args) name (case ?name - (#;Some name) + (#.Some name) (wrap name) - (^multi #;None - [(derivation-name (product;right poly-func) (list/map product;right poly-args)) - (#;Some derived-name)]) + (^multi #.None + [(derivation-name (product.right poly-func) (list/map product.right poly-args)) + (#.Some derived-name)]) (wrap derived-name) _ - (p;fail "derived: was given no explicit name, and cannot generate one from given information.")) + (p.fail "derived: was given no explicit name, and cannot generate one from given information.")) #let [impl (case ?custom-impl - (#;Some custom-impl) + (#.Some custom-impl) custom-impl - #;None - (` ((~ (code;symbol poly-func)) (~@ (list/map code;symbol poly-args)))))]] - (wrap (;list (` (def: (~@ (csw;export export)) - (~ (code;symbol ["" name])) - {#;struct? true} + #.None + (` ((~ (code.symbol poly-func)) (~@ (list/map code.symbol poly-args)))))]] + (wrap (.list (` (def: (~@ (csw.export export)) + (~ (code.symbol ["" name])) + {#.struct? true} (~ impl))))))) ## [Derivers] (def: #export (to-ast env type) (-> Env Type Code) (case type - (#;Primitive name params) - (` (#;Primitive (~ (code;text name)) + (#.Primitive name params) + (` (#.Primitive (~ (code.text name)) (list (~@ (list/map (to-ast env) params))))) (^template [<tag>] <tag> (` <tag>)) - ([#;Void] [#;Unit]) + ([#.Void] [#.Unit]) (^template [<tag>] (<tag> idx) - (` (<tag> (~ (code;nat idx))))) - ([#;Var] [#;Ex]) + (` (<tag> (~ (code.nat idx))))) + ([#.Var] [#.Ex]) - (#;Bound idx) + (#.Bound idx) (let [idx (adjusted-idx env idx)] (if (n/= +0 idx) - (|> (dict;get idx env) maybe;assume product;left (to-ast env)) - (` (;$ (~ (code;nat (n/dec idx))))))) + (|> (dict.get idx env) maybe.assume product.left (to-ast env)) + (` (.$ (~ (code.nat (n/dec idx))))))) - (#;Apply #;Void (#;Bound idx)) + (#.Apply #.Void (#.Bound idx)) (let [idx (adjusted-idx env idx)] (if (n/= +0 idx) - (|> (dict;get idx env) maybe;assume product;left (to-ast env)) + (|> (dict.get idx env) maybe.assume product.left (to-ast env)) (undefined))) (^template [<tag>] (<tag> left right) (` (<tag> (~ (to-ast env left)) (~ (to-ast env right))))) - ([#;Function] [#;Apply]) + ([#.Function] [#.Apply]) (^template [<tag> <macro> <flattener>] (<tag> left right) (` (<macro> (~@ (list/map (to-ast env) (<flattener> type)))))) - ([#;Sum | type;flatten-variant] - [#;Product & type;flatten-tuple]) + ([#.Sum | type.flatten-variant] + [#.Product & type.flatten-tuple]) - (#;Named name sub-type) - (code;symbol name) + (#.Named name sub-type) + (code.symbol name) (^template [<tag>] (<tag> scope body) (` (<tag> (list (~@ (list/map (to-ast env) scope))) (~ (to-ast env body))))) - ([#;UnivQ] [#;ExQ]) + ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 55927e614..46feab967 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] [eq] @@ -31,13 +31,13 @@ ## [Derivers] (poly: #export Eq<?> (`` (do @ - [#let [g!_ (code;local-symbol "\u0000_")] - *env* poly;env - inputT poly;peek + [#let [g!_ (code.local-symbol "\u0000_")] + *env* poly.env + inputT poly.peek #let [@Eq (: (-> Type Code) (function [type] - (` (eq;Eq (~ (poly;to-ast *env* type))))))]] - ($_ p;either + (` (eq.Eq (~ (poly.to-ast *env* type))))))]] + ($_ p.either ## Basic types (~~ (do-template [<matcher> <eq>] [(do @ @@ -45,103 +45,103 @@ (wrap (` (: (~ (@Eq inputT)) <eq>))))] - [poly;unit (function [(~ g!_) (~ g!_)] true)] - [poly;bool bool;Eq<Bool>] - [poly;nat number;Eq<Nat>] - [poly;int number;Eq<Int>] - [poly;deg number;Eq<Deg>] - [poly;frac number;Eq<Frac>] - [poly;text text;Eq<Text>])) + [poly.unit (function [(~ g!_) (~ g!_)] true)] + [poly.bool bool.Eq<Bool>] + [poly.nat number.Eq<Nat>] + [poly.int number.Eq<Int>] + [poly.deg number.Eq<Deg>] + [poly.frac number.Eq<Frac>] + [poly.text text.Eq<Text>])) ## Composite types (~~ (do-template [<name> <eq>] [(do @ - [[_ argC] (poly;apply (p;seq (poly;this <name>) + [[_ argC] (poly.apply (p.seq (poly.this <name>) Eq<?>))] (wrap (` (: (~ (@Eq inputT)) (<eq> (~ argC))))))] - [;Maybe maybe;Eq<Maybe>] - [;List list;Eq<List>] - [sequence;Sequence sequence;Eq<Sequence>] - [;Array array;Eq<Array>] - [queue;Queue queue;Eq<Queue>] - [set;Set set;Eq<Set>] - [rose;Tree rose;Eq<Tree>] + [.Maybe maybe.Eq<Maybe>] + [.List list.Eq<List>] + [sequence.Sequence sequence.Eq<Sequence>] + [.Array array.Eq<Array>] + [queue.Queue queue.Eq<Queue>] + [set.Set set.Eq<Set>] + [rose.Tree rose.Eq<Tree>] )) (do @ - [[_ _ valC] (poly;apply ($_ p;seq - (poly;this dict;Dict) - poly;any + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this dict.Dict) + poly.any Eq<?>))] (wrap (` (: (~ (@Eq inputT)) - (dict;Eq<Dict> (~ valC)))))) + (dict.Eq<Dict> (~ valC)))))) ## Models (~~ (do-template [<type> <eq>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@Eq inputT)) <eq>))))] - [du;Duration du;Eq<Duration>] - [i;Instant i;Eq<Instant>] - [da;Date da;Eq<Date>] - [da;Day da;Eq<Day>] - [da;Month da;Eq<Month>])) + [du.Duration du.Eq<Duration>] + [i.Instant i.Eq<Instant>] + [da.Date da.Eq<Date>] + [da.Day da.Eq<Day>] + [da.Month da.Eq<Month>])) (do @ - [_ (poly;apply (p;seq (poly;this unit;Qty) - poly;any))] + [_ (poly.apply (p.seq (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@Eq inputT)) - unit;Eq<Qty>)))) + unit.Eq<Qty>)))) ## Variants (do @ - [members (poly;variant (p;many Eq<?>)) - #let [g!left (code;local-symbol "\u0000left") - g!right (code;local-symbol "\u0000right")]] + [members (poly.variant (p.many Eq<?>)) + #let [g!left (code.local-symbol "\u0000left") + g!right (code.local-symbol "\u0000right")]] (wrap (` (: (~ (@Eq inputT)) (function [(~ g!left) (~ g!right)] (case [(~ g!left) (~ g!right)] (~@ (list/join (list/map (function [[tag g!eq]] - (list (` [((~ (code;nat tag)) (~ g!left)) - ((~ (code;nat tag)) (~ g!right))]) + (list (` [((~ (code.nat tag)) (~ g!left)) + ((~ (code.nat tag)) (~ g!right))]) (` ((~ g!eq) (~ g!left) (~ g!right))))) - (list;enumerate members)))) + (list.enumerate members)))) (~ g!_) false)))))) ## Tuples (do @ - [g!eqs (poly;tuple (p;many Eq<?>)) - #let [indices (|> (list;size g!eqs) n/dec (list;n/range +0)) - g!lefts (list/map (|>> nat/encode (text/compose "left") code;local-symbol) indices) - g!rights (list/map (|>> nat/encode (text/compose "right") code;local-symbol) indices)]] + [g!eqs (poly.tuple (p.many Eq<?>)) + #let [indices (|> (list.size g!eqs) n/dec (list.n/range +0)) + g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices) + g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]] (wrap (` (: (~ (@Eq inputT)) (function [[(~@ g!lefts)] [(~@ g!rights)]] - (and (~@ (|> (list;zip3 g!eqs g!lefts g!rights) + (and (~@ (|> (list.zip3 g!eqs g!lefts g!rights) (list/map (function [[g!eq g!left g!right]] (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion (do @ - [[g!self bodyC] (poly;recursive Eq<?>)] + [[g!self bodyC] (poly.recursive Eq<?>)] (wrap (` (: (~ (@Eq inputT)) - (eq;rec (;function [(~ g!self)] + (eq.rec (.function [(~ g!self)] (~ bodyC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [[funcC argsC] (poly;apply (p;seq Eq<?> (p;many Eq<?>)))] + [[funcC argsC] (poly.apply (p.seq Eq<?> (p.many Eq<?>)))] (wrap (` ((~ funcC) (~@ argsC))))) ## Bound type-vars - poly;bound + poly.bound ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Eq<?>)] + [[funcC varsC bodyC] (poly.polymorphic Eq<?>)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) eq;Eq (`)) varsC)) - (eq;Eq ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) + (-> (~@ (list/map (|>> (~) eq.Eq (`)) varsC)) + (eq.Eq ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;recursive-call + poly.recursive-call ## If all else fails... - (|> poly;any - (:: @ map (|>> %type (format "Cannot create Eq for: ") p;fail)) + (|> poly.any + (:: @ map (|>> %type (format "Cannot create Eq for: ") p.fail)) (:: @ join)) )))) diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index edd3efcc2..fbd8dcd03 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] [functor] @@ -17,45 +17,45 @@ (poly: #export Functor<?> (do @ - [#let [type-funcC (code;local-symbol "\u0000type-funcC") - funcC (code;local-symbol "\u0000funcC") - inputC (code;local-symbol "\u0000inputC")] - *env* poly;env - inputT poly;peek - [polyC varsC non-functorT] (poly;local (list inputT) - (poly;polymorphic poly;any)) - #let [num-vars (list;size varsC)] + [#let [type-funcC (code.local-symbol "\u0000type-funcC") + funcC (code.local-symbol "\u0000funcC") + inputC (code.local-symbol "\u0000inputC")] + *env* poly.env + inputT poly.peek + [polyC varsC non-functorT] (poly.local (list inputT) + (poly.polymorphic poly.any)) + #let [num-vars (list.size varsC)] #let [@Functor (: (-> Type Code) (function [unwrappedT] (if (n/= +1 num-vars) - (` (functor;Functor (~ (poly;to-ast *env* unwrappedT)))) - (let [paramsC (|> num-vars n/dec list;indices (L/map (|>> %n code;local-symbol)))] + (` (functor.Functor (~ (poly.to-ast *env* unwrappedT)))) + (let [paramsC (|> num-vars n/dec list.indices (L/map (|>> %n code.local-symbol)))] (` (All [(~@ paramsC)] - (functor;Functor ((~ (poly;to-ast *env* unwrappedT)) (~@ paramsC))))))))) - Arg<?> (: (-> Code (poly;Poly Code)) + (functor.Functor ((~ (poly.to-ast *env* unwrappedT)) (~@ paramsC))))))))) + Arg<?> (: (-> Code (poly.Poly Code)) (function Arg<?> [valueC] - ($_ p;either + ($_ p.either ## Type-var - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [varI (|> num-vars (n/* +2) n/dec)] - _ (poly;var varI)] + _ (poly.var varI)] (wrap (` ((~ funcC) (~ valueC))))) ## Variants (do @ [_ (wrap []) - membersC (poly;variant (p;many (Arg<?> valueC)))] + membersC (poly.variant (p.many (Arg<?> valueC)))] (wrap (` (case (~ valueC) (~@ (L/join (L/map (function [[tag memberC]] - (list (` ((~ (code;nat tag)) (~ valueC))) - (` ((~ (code;nat tag)) (~ memberC))))) - (list;enumerate membersC)))))))) + (list (` ((~ (code.nat tag)) (~ valueC))) + (` ((~ (code.nat tag)) (~ memberC))))) + (list.enumerate membersC)))))))) ## Tuples - (do p;Monad<Parser> - [pairsCC (: (poly;Poly (List [Code Code])) - (poly;tuple (loop [idx +0 + (do p.Monad<Parser> + [pairsCC (: (poly.Poly (List [Code Code])) + (poly.tuple (loop [idx +0 pairsCC (: (List [Code Code]) (list))] - (p;either (let [slotC (|> idx %n (format "\u0000slot") code;local-symbol)] + (p.either (let [slotC (|> idx %n (format "\u0000slot") code.local-symbol)] (do @ [_ (wrap []) memberC (Arg<?> slotC)] @@ -63,33 +63,33 @@ (L/compose pairsCC (list [slotC memberC]))))) (wrap pairsCC)))))] (wrap (` (case (~ valueC) - [(~@ (L/map product;left pairsCC))] - [(~@ (L/map product;right pairsCC))])))) + [(~@ (L/map product.left pairsCC))] + [(~@ (L/map product.right pairsCC))])))) ## Functions (do @ [_ (wrap []) - #let [outL (code;local-symbol "\u0000outL")] - [inT+ outC] (poly;function (p;many poly;any) + #let [outL (code.local-symbol "\u0000outL")] + [inT+ outC] (poly.function (p.many poly.any) (Arg<?> outL)) - #let [inC+ (|> (list;size inT+) n/dec - (list;n/range +0) - (L/map (|>> %n (format "\u0000inC") code;local-symbol)))]] + #let [inC+ (|> (list.size inT+) n/dec + (list.n/range +0) + (L/map (|>> %n (format "\u0000inC") code.local-symbol)))]] (wrap (` (function [(~@ inC+)] (let [(~ outL) ((~ valueC) (~@ inC+))] (~ outC)))))) ## Recursion - (do p;Monad<Parser> - [_ poly;recursive-call] + (do p.Monad<Parser> + [_ poly.recursive-call] (wrap (` ((~' map) (~ funcC) (~ valueC))))) ## Bound type-variables - (do p;Monad<Parser> - [_ poly;any] + (do p.Monad<Parser> + [_ poly.any] (wrap valueC)) )))] - [_ _ outputC] (: (poly;Poly [Code (List Code) Code]) - (p;either (poly;polymorphic + [_ _ outputC] (: (poly.Poly [Code (List Code) Code]) + (p.either (poly.polymorphic (Arg<?> inputC)) - (p;fail (format "Cannot create Functor for: " (%type inputT)))))] + (p.fail (format "Cannot create Functor for: " (%type inputT)))))] (wrap (` (: (~ (@Functor inputT)) (struct (def: ((~' map) (~ funcC) (~ inputC)) (~ outputC)))))))) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index d001d4839..3a5148377 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Codecs for values in the JSON format."} +(.module: {#.doc "Codecs for values in the JSON format."} lux (lux (control [monad #+ do Monad] [eq #+ Eq] @@ -43,42 +43,42 @@ (function [input] (non-rec (rec-encode non-rec) input))) -(def: low-mask Nat (|> +1 (bit;shift-left +32) n/dec)) -(def: high-mask Nat (|> low-mask (bit;shift-left +32))) +(def: low-mask Nat (|> +1 (bit.shift-left +32) n/dec)) +(def: high-mask Nat (|> low-mask (bit.shift-left +32))) (struct: #hidden _ (Codec JSON Nat) (def: (encode input) - (let [high (|> input (bit;and high-mask) (bit;shift-right +32)) - low (bit;and low-mask input)] - (#//;Array (sequence (|> high nat-to-int int-to-frac #//;Number) - (|> low nat-to-int int-to-frac #//;Number))))) + (let [high (|> input (bit.and high-mask) (bit.shift-right +32)) + low (bit.and low-mask input)] + (#//.Array (sequence (|> high nat-to-int int-to-frac #//.Number) + (|> low nat-to-int int-to-frac #//.Number))))) (def: (decode input) - (<| (//;run input) - (do p;Monad<Parser> - [high //;number - low //;number]) - (wrap (n/+ (|> high frac-to-int int-to-nat (bit;shift-left +32)) + (<| (//.run input) + (do p.Monad<Parser> + [high //.number + low //.number]) + (wrap (n/+ (|> high frac-to-int int-to-nat (bit.shift-left +32)) (|> low frac-to-int int-to-nat)))))) (struct: #hidden _ (Codec JSON Int) (def: encode (|>> int-to-nat (:: Codec<JSON,Nat> encode))) (def: decode - (|>> (:: Codec<JSON,Nat> decode) (:: e;Functor<Error> map nat-to-int)))) + (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map nat-to-int)))) (def: #hidden (nullable writer) - {#;doc "Builds a JSON generator for potentially inexistent values."} + {#.doc "Builds a JSON generator for potentially inexistent values."} (All [a] (-> (-> a JSON) (-> (Maybe a) JSON))) (function [elem] (case elem - #;None #//;Null - (#;Some value) (writer value)))) + #.None #//.Null + (#.Some value) (writer value)))) (struct: #hidden (Codec<JSON,Qty> carrier) - (All [unit] (-> unit (Codec JSON (unit;Qty unit)))) + (All [unit] (-> unit (Codec JSON (unit.Qty unit)))) (def: encode - (|>> unit;out (:: Codec<JSON,Int> encode))) + (|>> unit.out (:: Codec<JSON,Int> encode))) (def: decode - (|>> (:: Codec<JSON,Int> decode) (:: e;Functor<Error> map (unit;in carrier))))) + (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier))))) (poly: #hidden Codec<JSON,?>//encode (with-expansions @@ -88,108 +88,108 @@ (wrap (` (: (~ (@JSON//encode inputT)) <encoder>))))] - [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #//;Null)] - [Bool poly;bool (|>> #//;Boolean)] - [Nat poly;nat (:: ;;Codec<JSON,Nat> (~' encode))] - [Int poly;int (:: ;;Codec<JSON,Int> (~' encode))] - [Frac poly;frac (|>> #//;Number)] - [Text poly;text (|>> #//;String)]) + [Unit poly.unit (function [(~ (code.symbol ["" "0"]))] #//.Null)] + [Bool poly.bool (|>> #//.Boolean)] + [Nat poly.nat (:: ..Codec<JSON,Nat> (~' encode))] + [Int poly.int (:: ..Codec<JSON,Int> (~' encode))] + [Frac poly.frac (|>> #//.Number)] + [Text poly.text (|>> #//.String)]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (:: <codec> (~' encode)) #//;String)))))] + (|>> (:: <codec> (~' encode)) #//.String)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//encode (: (-> Type Code) (function [type] - (` (-> (~ (poly;to-ast *env* type)) //;JSON))))] - inputT poly;peek] - ($_ p;either + (` (-> (~ (poly.to-ast *env* type)) //.JSON))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//encode inputT)) - (:: (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) (~' encode)))))) + (:: (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode)))))) (do @ - [#let [g!key (code;local-symbol "\u0000key") - g!val (code;local-symbol "\u0000val")] - [_ _ .val.] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [#let [g!key (code.local-symbol "\u0000key") + g!val (code.local-symbol "\u0000val")] + [_ _ =val=] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> d;entries - (;;_map_ (function [[(~ g!key) (~ g!val)]] - [(~ g!key) ((~ .val.) (~ g!val))])) - (d;from-list text;Hash<Text>) - #//;Object))))) + (|>> d.entries + (.._map_ (function [[(~ g!key) (~ g!val)]] + [(~ g!key) ((~ =val=) (~ g!val))])) + (d.from-list text.Hash<Text>) + #//.Object))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;Maybe) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .Maybe) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (;;nullable (~ .sub.)))))) + (..nullable (~ =sub=)))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;List) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .List) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (;;_map_ (~ .sub.)) sequence;from-list #//;Array))))) + (|>> (.._map_ (~ =sub=)) sequence.from-list #//.Array))))) (do @ - [#let [g!input (code;local-symbol "\u0000input")] - members (poly;variant (p;many Codec<JSON,?>//encode))] + [#let [g!input (code.local-symbol "\u0000input")] + members (poly.variant (p.many Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (function [(~ g!input)] (case (~ g!input) (~@ (list/join (list/map (function [[tag g!encode]] - (list (` ((~ (code;nat tag)) (~ g!input))) - (` (//;json [(~ (code;frac (;;tag tag))) + (list (` ((~ (code.nat tag)) (~ g!input))) + (` (//.json [(~ (code.frac (..tag tag))) ((~ g!encode) (~ g!input))])))) - (list;enumerate members)))))))))) + (list.enumerate members)))))))))) (do @ - [g!encoders (poly;tuple (p;many Codec<JSON,?>//encode)) - #let [g!members (|> (list;size g!encoders) n/dec - (list;n/range +0) - (list/map (|>> nat/encode code;local-symbol)))]] + [g!encoders (poly.tuple (p.many Codec<JSON,?>//encode)) + #let [g!members (|> (list.size g!encoders) n/dec + (list.n/range +0) + (list/map (|>> nat/encode code.local-symbol)))]] (wrap (` (: (~ (@JSON//encode inputT)) (function [[(~@ g!members)]] - (//;json [(~@ (list/map (function [[g!member g!encode]] + (//.json [(~@ (list/map (function [[g!member g!encode]] (` ((~ g!encode) (~ g!member)))) - (list;zip2 g!members g!encoders)))])))))) + (list.zip2 g!members g!encoders)))])))))) ## Type recursion (do @ - [[selfC non-recC] (poly;recursive Codec<JSON,?>//encode)] + [[selfC non-recC] (poly.recursive Codec<JSON,?>//encode)] (wrap (` (: (~ (@JSON//encode inputT)) - (;;rec-encode (;function [(~ selfC)] + (..rec-encode (.function [(~ selfC)] (~ non-recC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [partsC (poly;apply (p;many Codec<JSON,?>//encode))] + [partsC (poly.apply (p.many Codec<JSON,?>//encode))] (wrap (` ((~@ partsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//encode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//encode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (function [varC] (` (-> (~ varC) //;JSON))) + (-> (~@ (list/map (function [varC] (` (-> (~ varC) //.JSON))) varsC)) - (-> ((~ (poly;to-ast *env* inputT)) (~@ varsC)) - //;JSON))) + (-> ((~ (poly.to-ast *env* inputT)) (~@ varsC)) + //.JSON))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON encoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON encoder for: " (type.to-text inputT))) )))) (poly: #hidden Codec<JSON,?>//decode @@ -200,94 +200,94 @@ (wrap (` (: (~ (@JSON//decode inputT)) <decoder>))))] - [Unit poly;unit //;null] - [Bool poly;bool //;boolean] - [Nat poly;nat (p;codec ;;Codec<JSON,Nat> //;any)] - [Int poly;int (p;codec ;;Codec<JSON,Int> //;any)] - [Frac poly;frac //;number] - [Text poly;text //;string]) + [Unit poly.unit //.null] + [Bool poly.bool //.boolean] + [Nat poly.nat (p.codec ..Codec<JSON,Nat> //.any)] + [Int poly.int (p.codec ..Codec<JSON,Int> //.any)] + [Frac poly.frac //.number] + [Text poly.text //.string]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec <codec> //;string)))))] + (p.codec <codec> //.string)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//decode (: (-> Type Code) (function [type] - (` (//;Reader (~ (poly;to-ast *env* type))))))] - inputT poly;peek] - ($_ p;either + (` (//.Reader (~ (poly.to-ast *env* type))))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) //;any))))) + (p.codec (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) //.any))))) (do @ - [[_ _ valC] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;object (~ valC)))))) + (//.object (~ valC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;Maybe) + [[_ subC] (poly.apply (p.seq (poly.this .Maybe) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;nullable (~ subC)))))) + (//.nullable (~ subC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;List) + [[_ subC] (poly.apply (p.seq (poly.this .List) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array (p;some (~ subC))))))) + (//.array (p.some (~ subC))))))) (do @ - [members (poly;variant (p;many Codec<JSON,?>//decode))] + [members (poly.variant (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - ($_ p;alt + ($_ p.alt (~@ (list/map (function [[tag memberC]] (` (|> (~ memberC) - (p;after (//;number! (~ (code;frac (;;tag tag))))) - //;array))) - (list;enumerate members)))))))) + (p.after (//.number! (~ (code.frac (..tag tag))))) + //.array))) + (list.enumerate members)))))))) (do @ - [g!decoders (poly;tuple (p;many Codec<JSON,?>//decode))] + [g!decoders (poly.tuple (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array ($_ p;seq (~@ g!decoders))))))) + (//.array ($_ p.seq (~@ g!decoders))))))) ## Type recursion (do @ - [[selfC bodyC] (poly;recursive Codec<JSON,?>//decode)] + [[selfC bodyC] (poly.recursive Codec<JSON,?>//decode)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;rec (;function [(~ selfC)] + (p.rec (.function [(~ selfC)] (~ bodyC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [[funcC argsC] (poly;apply (p;seq Codec<JSON,?>//decode (p;many Codec<JSON,?>//decode)))] + [[funcC argsC] (poly.apply (p.seq Codec<JSON,?>//decode (p.many Codec<JSON,?>//decode)))] (wrap (` ((~ funcC) (~@ argsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//decode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//decode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) //;Reader (`)) varsC)) - (//;Reader ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) + (-> (~@ (list/map (|>> (~) //.Reader (`)) varsC)) + (//.Reader ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON decoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON decoder for: " (type.to-text inputT))) )))) (syntax: #export (Codec<JSON,?> inputT) - {#;doc (doc "A macro for automatically producing JSON codecs." + {#.doc (doc "A macro for automatically producing JSON codecs." (type: Variant (#Case0 Bool) (#Case1 Text) @@ -306,7 +306,7 @@ (derived: (Codec<JSON,?> Record)))} (with-gensyms [g!inputs] - (wrap (list (` (: (Codec //;JSON (~ inputT)) + (wrap (list (` (: (Codec //.JSON (~ inputT)) (struct (def: (~' encode) (Codec<JSON,?>//encode (~ inputT))) - (def: ((~' decode) (~ g!inputs)) (//;run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) + (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) ))))))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index bc3369f86..b18e0763f 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [macro #+ with-gensyms] (control [monad #+ do Monad] @@ -18,189 +18,189 @@ (def: (join-pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs - #;Nil #;Nil - (#;Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) + #.Nil #.Nil + (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) ## [Types] (type: #export Syntax - {#;doc "A Lux syntax parser."} - (p;Parser (List Code))) + {#.doc "A Lux syntax parser."} + (p.Parser (List Code))) ## [Utils] (def: (remaining-inputs asts) (-> (List Code) Text) ($_ text/compose "\nRemaining input: " - (|> asts (list/map code;to-text) (list;interpose " ") (text;join-with "")))) + (|> asts (list/map code.to-text) (list.interpose " ") (text.join-with "")))) ## [Syntaxs] (def: #export any - {#;doc "Just returns the next input without applying any logic."} + {#.doc "Just returns the next input without applying any logic."} (Syntax Code) (function [tokens] (case tokens - #;Nil (#E;Error "There are no tokens to parse!") - (#;Cons [t tokens']) (#E;Success [tokens' t])))) + #.Nil (#E.Error "There are no tokens to parse!") + (#.Cons [t tokens']) (#E.Success [tokens' t])))) (do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> - {#;doc (code;text ($_ text/compose "Parses the next " <desc> " input Code."))} + {#.doc (code.text ($_ text/compose "Parses the next " <desc> " input Code."))} (Syntax <type>) (function [tokens] (case tokens - (#;Cons [[_ (<tag> x)] tokens']) - (#E;Success [tokens' x]) + (#.Cons [[_ (<tag> x)] tokens']) + (#E.Success [tokens' x]) _ - (#E;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] - - [ bool Bool #;Bool bool;Eq<Bool> "bool"] - [ nat Nat #;Nat number;Eq<Nat> "nat"] - [ int Int #;Int number;Eq<Int> "int"] - [ deg Deg #;Deg number;Eq<Deg> "deg"] - [ frac Frac #;Frac number;Eq<Frac> "frac"] - [ text Text #;Text text;Eq<Text> "text"] - [symbol Ident #;Symbol ident;Eq<Ident> "symbol"] - [ tag Ident #;Tag ident;Eq<Ident> "tag"] + (#E.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + + [ bool Bool #.Bool bool.Eq<Bool> "bool"] + [ nat Nat #.Nat number.Eq<Nat> "nat"] + [ int Int #.Int number.Eq<Int> "int"] + [ deg Deg #.Deg number.Eq<Deg> "deg"] + [ frac Frac #.Frac number.Eq<Frac> "frac"] + [ text Text #.Text text.Eq<Text> "text"] + [symbol Ident #.Symbol ident.Eq<Ident> "symbol"] + [ tag Ident #.Tag ident.Eq<Ident> "tag"] ) (def: #export (this? ast) - {#;doc "Asks if the given Code is the next input."} + {#.doc "Asks if the given Code is the next input."} (-> Code (Syntax Bool)) (function [tokens] (case tokens - (#;Cons [token tokens']) + (#.Cons [token tokens']) (let [is-it? (code/= ast token) remaining (if is-it? tokens' tokens)] - (#E;Success [remaining is-it?])) + (#E.Success [remaining is-it?])) _ - (#E;Success [tokens false])))) + (#E.Success [tokens false])))) (def: #export (this ast) - {#;doc "Ensures the given Code is the next input."} + {#.doc "Ensures the given Code is the next input."} (-> Code (Syntax Unit)) (function [tokens] (case tokens - (#;Cons [token tokens']) + (#.Cons [token tokens']) (if (code/= ast token) - (#E;Success [tokens' []]) - (#E;Error ($_ text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token) + (#E.Success [tokens' []]) + (#E.Error ($_ text/compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token) (remaining-inputs tokens)))) _ - (#E;Error "There are no tokens to parse!")))) + (#E.Error "There are no tokens to parse!")))) (do-template [<name> <tag> <desc>] [(def: #export <name> - {#;doc (code;text ($_ text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} + {#.doc (code.text ($_ text/compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} (Syntax Text) (function [tokens] (case tokens - (#;Cons [[_ (<tag> ["" x])] tokens']) - (#E;Success [tokens' x]) + (#.Cons [[_ (<tag> ["" x])] tokens']) + (#E.Success [tokens' x]) _ - (#E;Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] + (#E.Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] - [local-symbol #;Symbol "symbol"] - [ local-tag #;Tag "tag"] + [local-symbol #.Symbol "symbol"] + [ local-tag #.Tag "tag"] ) (do-template [<name> <tag> <desc>] [(def: #export (<name> p) - {#;doc (code;text ($_ text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} + {#.doc (code.text ($_ text/compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] (case tokens - (#;Cons [[_ (<tag> members)] tokens']) + (#.Cons [[_ (<tag> members)] tokens']) (case (p members) - (#E;Success [#;Nil x]) (#E;Success [tokens' x]) - _ (#E;Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) + (#E.Success [#.Nil x]) (#E.Success [tokens' x]) + _ (#E.Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) _ - (#E;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#E.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] - [ form #;Form "form"] - [tuple #;Tuple "tuple"] + [ form #.Form "form"] + [tuple #.Tuple "tuple"] ) (def: #export (record p) - {#;doc (code;text ($_ text/compose "Parse inside the contents of a record as if they were the input Codes."))} + {#.doc (code.text ($_ text/compose "Parse inside the contents of a record as if they were the input Codes."))} (All [a] (-> (Syntax a) (Syntax a))) (function [tokens] (case tokens - (#;Cons [[_ (#;Record pairs)] tokens']) + (#.Cons [[_ (#.Record pairs)] tokens']) (case (p (join-pairs pairs)) - (#E;Success [#;Nil x]) (#E;Success [tokens' x]) - _ (#E;Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) + (#E.Success [#.Nil x]) (#E.Success [tokens' x]) + _ (#E.Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) _ - (#E;Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) + (#E.Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) (def: #export end! - {#;doc "Ensures there are no more inputs."} + {#.doc "Ensures there are no more inputs."} (Syntax Unit) (function [tokens] (case tokens - #;Nil (#E;Success [tokens []]) - _ (#E;Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + #.Nil (#E.Success [tokens []]) + _ (#E.Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) (def: #export end? - {#;doc "Checks whether there are no more inputs."} + {#.doc "Checks whether there are no more inputs."} (Syntax Bool) (function [tokens] (case tokens - #;Nil (#E;Success [tokens true]) - _ (#E;Success [tokens false])))) + #.Nil (#E.Success [tokens true]) + _ (#E.Success [tokens false])))) (def: #export (on compiler action) - {#;doc "Run a Lux operation as if it was a Syntax parser."} + {#.doc "Run a Lux operation as if it was a Syntax parser."} (All [a] (-> Compiler (Meta a) (Syntax a))) (function [input] - (case (macro;run compiler action) - (#E;Error error) - (#E;Error error) + (case (macro.run compiler action) + (#E.Error error) + (#E.Error error) - (#E;Success value) - (#E;Success [input value]) + (#E.Success value) + (#E.Success [input value]) ))) (def: #export (run inputs syntax) - (All [a] (-> (List Code) (Syntax a) (E;Error a))) + (All [a] (-> (List Code) (Syntax a) (E.Error a))) (case (syntax inputs) - (#E;Error error) - (#E;Error error) + (#E.Error error) + (#E.Error error) - (#E;Success [unconsumed value]) + (#E.Success [unconsumed value]) (case unconsumed - #;Nil - (#E;Success value) + #.Nil + (#E.Success value) _ - (#E;Error (text/compose "Unconsumed inputs: " - (|> (list/map code;to-text unconsumed) - (text;join-with ", "))))))) + (#E.Error (text/compose "Unconsumed inputs: " + (|> (list/map code.to-text unconsumed) + (text.join-with ", "))))))) (def: #export (local inputs syntax) - {#;doc "Run a syntax parser with the given list of inputs, instead of the real ones."} + {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."} (All [a] (-> (List Code) (Syntax a) (Syntax a))) (function [real] - (do E;Monad<Error> + (do E.Monad<Error> [value (run inputs syntax)] (wrap [real value])))) ## [Syntax] -(def: #hidden text.join-with text;join-with) +(def: #hidden text/join-with text.join-with) -(def: #hidden _run_ p;run) -(def: #hidden _Monad<Parser>_ p;Monad<Parser>) +(def: #hidden _run_ p.run) +(def: #hidden _Monad<Parser>_ p.Monad<Parser>) (macro: #export (syntax: tokens) - {#;doc (doc "A more advanced way to define macros than macro:." + {#.doc (doc "A more advanced way to define macros than macro:." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Monad<Meta>, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." @@ -211,76 +211,76 @@ [constructor-args (constructor-args^ imports class-vars)] [methods (some (overriden-method-def^ imports))]) (let [def-code ($_ text/compose "anon-class:" - (spaced (list (super-class-decl$ (maybe;default object-super-class super)) + (spaced (list (super-class-decl$ (maybe.default object-super-class super)) (with-brackets (spaced (list/map super-class-decl$ interfaces))) (with-brackets (spaced (list/map constructor-arg$ constructor-args))) (with-brackets (spaced (list/map (method-def$ id) methods))))))] - (wrap (list (` ((~ (code;text def-code)))))))))} + (wrap (list (` ((~ (code.text def-code)))))))))} (let [[exported? tokens] (: [(Maybe (Either Unit Unit)) (List Code)] (case tokens - (^ (list& [_ (#;Tag ["" "hidden"])] tokens')) - [(#;Some #;Left) tokens'] + (^ (list& [_ (#.Tag ["" "hidden"])] tokens')) + [(#.Some #.Left) tokens'] - (^ (list& [_ (#;Tag ["" "export"])] tokens')) - [(#;Some #;Right) tokens'] + (^ (list& [_ (#.Tag ["" "export"])] tokens')) + [(#.Some #.Right) tokens'] _ - [#;None tokens])) + [#.None tokens])) ?parts (: (Maybe [Text (List Code) Code Code]) (case tokens - (^ (list [_ (#;Form (list& [_ (#;Symbol ["" name])] args))] + (^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))] body)) - (#;Some name args (` {}) body) + (#.Some name args (` {}) body) - (^ (list [_ (#;Form (list& [_ (#;Symbol ["" name])] args))] + (^ (list [_ (#.Form (list& [_ (#.Symbol ["" name])] args))] meta-data body)) - (#;Some name args meta-data body) + (#.Some name args meta-data body) _ - #;None))] + #.None))] (case ?parts - (#;Some [name args meta body]) + (#.Some [name args meta body]) (with-gensyms [g!tokens g!body g!msg] - (do macro;Monad<Meta> - [vars+parsers (monad;map @ + (do macro.Monad<Meta> + [vars+parsers (monad.map @ (: (-> Code (Meta [Code Code])) (function [arg] (case arg - (^ [_ (#;Tuple (list var parser))]) + (^ [_ (#.Tuple (list var parser))]) (wrap [var parser]) - [_ (#;Symbol var-name)] - (wrap [(code;symbol var-name) (` any)]) + [_ (#.Symbol var-name)] + (wrap [(code.symbol var-name) (` any)]) _ - (macro;fail "Syntax pattern expects tuples or symbols.")))) + (macro.fail "Syntax pattern expects tuples or symbols.")))) args) - #let [g!state (code;symbol ["" "*compiler*"]) - error-msg (code;text (text/compose "Wrong syntax for " name)) + #let [g!state (code.symbol ["" "*compiler*"]) + error-msg (code.text (text/compose "Wrong syntax for " name)) export-ast (: (List Code) (case exported? - (#;Some #;Left) + (#.Some #.Left) (list (' #hidden)) - (#;Some #;Right) + (#.Some #.Right) (list (' #export)) _ (list)))]] - (wrap (list (` (macro: (~@ export-ast) ((~ (code;symbol ["" name])) (~ g!tokens) (~ g!state)) + (wrap (list (` (macro: (~@ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state)) (~ meta) - ("lux case" (;;run (~ g!tokens) + ("lux case" (..run (~ g!tokens) (: (Syntax (Meta (List Code))) - (do ;;_Monad<Parser>_ + (do .._Monad<Parser>_ [(~@ (join-pairs vars+parsers))] - ((~' wrap) (do macro;Monad<Meta> + ((~' wrap) (do macro.Monad<Meta> [] (~ body)))))) - {(#E;Success (~ g!body)) + {(#E.Success (~ g!body)) ((~ g!body) (~ g!state)) - (#E;Error (~ g!msg)) - (#E;Error (text.join-with ": " (list (~ error-msg) (~ g!msg))))}))))))) + (#E.Error (~ g!msg)) + (#E.Error (text/join-with ": " (list (~ error-msg) (~ g!msg))))}))))))) _ - (macro;fail "Wrong syntax for syntax:")))) + (macro.fail "Wrong syntax for syntax:")))) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index 72e52a4ab..8c684537e 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Commons syntax readers and writers. +(.module: {#.doc "Commons syntax readers and writers. The goal is to be able to reuse common syntax in macro definitions across libraries."} lux) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 7759a7561..ac6d876c3 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Commons syntax readers."} +(.module: {#.doc "Commons syntax readers."} lux (lux (control monad ["p" parser]) @@ -12,139 +12,139 @@ ## Exports (def: #export export - {#;doc (doc "A reader for export levels." + {#.doc (doc "A reader for export levels." "Such as:" #export #hidden)} (Syntax (Maybe Export)) - (p;maybe (p;alt (s;this (' #export)) - (s;this (' #hidden))))) + (p.maybe (p.alt (s.this (' #export)) + (s.this (' #hidden))))) ## Declarations (def: #export declaration - {#;doc (doc "A reader for declaration syntax." + {#.doc (doc "A reader for declaration syntax." "Such as:" quux (foo bar baz))} (Syntax Declaration) - (p;either (p;seq s;local-symbol - (:: p;Monad<Parser> wrap (list))) - (s;form (p;seq s;local-symbol - (p;many s;local-symbol))))) + (p.either (p.seq s.local-symbol + (:: p.Monad<Parser> wrap (list))) + (s.form (p.seq s.local-symbol + (p.many s.local-symbol))))) ## Annotations (def: #export annotations - {#;doc "Reader for the common annotations syntax used by def: statements."} + {#.doc "Reader for the common annotations syntax used by def: statements."} (Syntax Annotations) - (s;record (p;some (p;seq s;tag s;any)))) + (s.record (p.some (p.seq s.tag s.any)))) ## Definitions (def: check^ (Syntax [(Maybe Code) Code]) - (p;either (s;form (do p;Monad<Parser> - [_ (s;this (' "lux check")) - type s;any - value s;any] - (wrap [(#;Some type) value]))) - (p;seq (:: p;Monad<Parser> wrap #;None) - s;any))) + (p.either (s.form (do p.Monad<Parser> + [_ (s.this (' "lux check")) + type s.any + value s.any] + (wrap [(#.Some type) value]))) + (p.seq (:: p.Monad<Parser> wrap #.None) + s.any))) (def: _definition-anns-tag^ (Syntax Ident) - (s;tuple (p;seq s;text s;text))) + (s.tuple (p.seq s.text s.text))) (def: (_definition-anns^ _) (-> Top (Syntax Annotations)) - (p;alt (s;this (' #lux;Nil)) - (s;form (do p;Monad<Parser> - [_ (s;this (' #lux;Cons)) - [head tail] (p;seq (s;tuple (p;seq _definition-anns-tag^ s;any)) + (p.alt (s.this (' #.Nil)) + (s.form (do p.Monad<Parser> + [_ (s.this (' #.Cons)) + [head tail] (p.seq (s.tuple (p.seq _definition-anns-tag^ s.any)) (_definition-anns^ []))] (wrap [head tail]))) )) (def: (flat-list^ _) (-> Top (Syntax (List Code))) - (p;either (do p;Monad<Parser> - [_ (s;this (' #lux;Nil))] + (p.either (do p.Monad<Parser> + [_ (s.this (' #.Nil))] (wrap (list))) - (s;form (do p;Monad<Parser> - [_ (s;this (' #lux;Cons)) - [head tail] (s;tuple (p;seq s;any s;any)) - tail (s;local (list tail) (flat-list^ []))] - (wrap (#;Cons head tail)))))) + (s.form (do p.Monad<Parser> + [_ (s.this (' #.Cons)) + [head tail] (s.tuple (p.seq s.any s.any)) + tail (s.local (list tail) (flat-list^ []))] + (wrap (#.Cons head tail)))))) (do-template [<name> <type> <tag> <then>] [(def: <name> (Syntax <type>) - (<| s;tuple - (p;after s;any) - s;form - (do p;Monad<Parser> - [_ (s;this (' <tag>))] + (<| s.tuple + (p.after s.any) + s.form + (do p.Monad<Parser> + [_ (s.this (' <tag>))] <then>)))] - [tuple-meta^ (List Code) #lux;Tuple (flat-list^ [])] - [text-meta^ Text #lux;Text s;text] + [tuple-meta^ (List Code) #.Tuple (flat-list^ [])] + [text-meta^ Text #.Text s.text] ) (def: (find-definition-args meta-data) (-> (List [Ident Code]) (List Text)) - (<| (maybe;default (list)) - (case (list;find (|>> product;left (ident/= ["lux" "func-args"])) meta-data) - (^multi (#;Some [_ value]) - [(p;run (list value) tuple-meta^) - (#;Right [_ args])] - [(p;run args (p;some text-meta^)) - (#;Right [_ args])]) - (#;Some args) + (<| (maybe.default (list)) + (case (list.find (|>> product.left (ident/= ["lux" "func-args"])) meta-data) + (^multi (#.Some [_ value]) + [(p.run (list value) tuple-meta^) + (#.Right [_ args])] + [(p.run args (p.some text-meta^)) + (#.Right [_ args])]) + (#.Some args) _ - #;None) + #.None) )) (def: #export (definition compiler) - {#;doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} + {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} (-> Compiler (Syntax Definition)) - (do p;Monad<Parser> - [definition-raw s;any - me-definition-raw (s;on compiler - (macro;expand-all definition-raw))] - (s;local me-definition-raw - (s;form (do @ - [_ (s;this (' "lux def")) - definition-name s;local-symbol + (do p.Monad<Parser> + [definition-raw s.any + me-definition-raw (s.on compiler + (macro.expand-all definition-raw))] + (s.local me-definition-raw + (s.form (do @ + [_ (s.this (' "lux def")) + definition-name s.local-symbol [?definition-type definition-value] check^ - definition-anns s;any - definition-anns (s;local (list definition-anns) + definition-anns s.any + definition-anns (s.local (list definition-anns) (_definition-anns^ [])) #let [definition-args (find-definition-args definition-anns)]] - (wrap {#//;definition-name definition-name - #//;definition-type ?definition-type - #//;definition-anns definition-anns - #//;definition-value definition-value - #//;definition-args definition-args})))))) + (wrap {#//.definition-name definition-name + #//.definition-type ?definition-type + #//.definition-anns definition-anns + #//.definition-value definition-value + #//.definition-args definition-args})))))) (def: #export (typed-definition compiler) - {#;doc "A reader for definitions that ensures the input syntax is typed."} + {#.doc "A reader for definitions that ensures the input syntax is typed."} (-> Compiler (Syntax Definition)) - (do p;Monad<Parser> + (do p.Monad<Parser> [_definition (definition compiler) - _ (case (get@ #//;definition-type _definition) - (#;Some _) + _ (case (get@ #//.definition-type _definition) + (#.Some _) (wrap []) - #;None - (p;fail "Typed definition must have a type!") + #.None + (p.fail "Typed definition must have a type!") )] (wrap _definition))) (def: #export typed-input - {#;doc "Reader for the common typed-argument syntax used by many macros."} + {#.doc "Reader for the common typed-argument syntax used by many macros."} (Syntax [Text Code]) - (s;tuple (p;seq s;local-symbol s;any))) + (s.tuple (p.seq s.local-symbol s.any))) (def: #export type-variables - {#;doc "Reader for the common type var/param used by many macros."} + {#.doc "Reader for the common type var/param used by many macros."} (Syntax (List Text)) - (s;tuple (p;some s;local-symbol))) + (s.tuple (p.some s.local-symbol))) diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index 1a75e7309..d5ad8cb61 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Commons syntax writers."} +(.module: {#.doc "Commons syntax writers."} lux (lux (data (coll [list "L/" Functor<List>]) [product]) @@ -9,16 +9,16 @@ (def: #export (export ?el) (-> (Maybe Export) (List Code)) (case ?el - #;None + #.None (list) - (#;Some #//;Exported) + (#.Some #//.Exported) (list (' #export)) - (#;Some #//;Hidden) + (#.Some #//.Hidden) (list (' #hidden)))) ## Annotations (def: #export (annotations anns) (-> Annotations Code) - (|> anns (L/map (product;both code;tag id)) code;record)) + (|> anns (L/map (product.both code.tag id)) code.record)) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 4f4270c74..c8cfe89df 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Common mathematical constants and functions."} +(.module: {#.doc "Common mathematical constants and functions."} lux (lux (control monad ["p" parser "p/" Functor<Parser>]) @@ -11,7 +11,7 @@ ## [Values] (do-template [<name> <value> <doc>] [(def: #export <name> - {#;doc <doc>} + {#.doc <doc>} Frac <value>)] @@ -75,14 +75,14 @@ (pow 2.0 catB)))) (def: #export (gcd a b) - {#;doc "Greatest Common Divisor."} + {#.doc "Greatest Common Divisor."} (-> Nat Nat Nat) (case b +0 a _ (gcd b (n/% b a)))) (def: #export (lcm x y) - {#;doc "Least Common Multiple."} + {#.doc "Least Common Multiple."} (-> Nat Nat Nat) (case [x y] (^or [_ +0] [+0 _]) @@ -101,37 +101,37 @@ (def: infix^ (Syntax Infix) - (<| p;rec (function [infix^]) - ($_ p;alt - ($_ p;either - (p/map code;bool s;bool) - (p/map code;nat s;nat) - (p/map code;int s;int) - (p/map code;deg s;deg) - (p/map code;frac s;frac) - (p/map code;text s;text) - (p/map code;symbol s;symbol) - (p/map code;tag s;tag)) - (s;form (p;many s;any)) - (s;tuple (p;seq s;any infix^)) - (s;tuple ($_ p;either - (do p;Monad<Parser> - [_ (s;this (' #and)) + (<| p.rec (function [infix^]) + ($_ p.alt + ($_ p.either + (p/map code.bool s.bool) + (p/map code.nat s.nat) + (p/map code.int s.int) + (p/map code.deg s.deg) + (p/map code.frac s.frac) + (p/map code.text s.text) + (p/map code.symbol s.symbol) + (p/map code.tag s.tag)) + (s.form (p.many s.any)) + (s.tuple (p.seq s.any infix^)) + (s.tuple ($_ p.either + (do p.Monad<Parser> + [_ (s.this (' #and)) init-subject infix^ - init-op s;any + init-op s.any init-param infix^ - steps (p;some (p;seq s;any infix^))] - (wrap (product;right (L/fold (function [[op param] [subject [_subject _op _param]]] + steps (p.some (p.seq s.any infix^))] + (wrap (product.right (L/fold (function [[op param] [subject [_subject _op _param]]] [param [(#Binary _subject _op _param) (` and) (#Binary subject op param)]]) [init-param [init-subject init-op init-param]] steps)))) - (do p;Monad<Parser> + (do p.Monad<Parser> [init-subject infix^ - init-op s;any + init-op s.any init-param infix^ - steps (p;some (p;seq s;any infix^))] + steps (p.some (p.seq s.any infix^))] (wrap (L/fold (function [[op param] [_subject _op _param]] [(#Binary _subject _op _param) op param]) [init-subject init-op init-param] @@ -146,7 +146,7 @@ value (#Call parts) - (code;form parts) + (code.form parts) (#Unary op subject) (` ((~ op) (~ (infix-to-prefix subject)))) @@ -156,7 +156,7 @@ )) (syntax: #export (infix [expr infix^]) - {#;doc (doc "Infix math syntax." + {#.doc (doc "Infix math syntax." (infix [x i/* 10]) (infix [[x i/+ y] i/* [x i/- y]]) (infix [sin [x i/+ y]]) diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux index 0b385dae2..6e9de446a 100644 --- a/stdlib/source/lux/math/logic/continuous.lux +++ b/stdlib/source/lux/math/logic/continuous.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [number "Deg/" Interval<Deg>]))) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index ba8da7d40..ca1ad0512 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [number "Deg/" Interval<Deg>] (coll [list] @@ -17,46 +17,46 @@ (def: #export (union left right) (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a))) (function [elem] - (&;~or (membership elem left) + (&.~or (membership elem left) (membership elem right)))) (def: #export (intersection left right) (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a))) (function [elem] - (&;~and (membership elem left) + (&.~and (membership elem left) (membership elem right)))) (def: #export (complement set) (All [a] (-> (Fuzzy a) (Fuzzy a))) (function [elem] - (&;~not (membership elem set)))) + (&.~not (membership elem set)))) (def: #export (difference sub base) (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a))) (function [elem] - (&;~and (membership elem base) - (&;~not (membership elem sub))))) + (&.~and (membership elem base) + (&.~not (membership elem sub))))) (def: #export (from-predicate predicate) (All [a] (-> (-> a Bool) (Fuzzy a))) (function [elem] (if (predicate elem) - &;~true - &;~false))) + &.~true + &.~false))) (def: #export (from-set set) - (All [a] (-> (set;Set a) (Fuzzy a))) - (from-predicate (set;member? set))) + (All [a] (-> (set.Set a) (Fuzzy a))) + (from-predicate (set.member? set))) (do-template [<ascending> <descending> <gradient> <type> <lt> <gt> <lte> <gte> <sub> <div> <post>] [(def: (<ascending> from to) (-> <type> <type> (Fuzzy <type>)) (function [elem] (cond (<lte> from elem) - &;~false + &.~false (<gte> to elem) - &;~true + &.~true ## in the middle... (<post> (<div> (<sub> from to) @@ -66,10 +66,10 @@ (-> <type> <type> (Fuzzy <type>)) (function [elem] (cond (<lte> from elem) - &;~true + &.~true (<gte> to elem) - &;~false + &.~false ## in the middle... (<post> (<div> (<sub> from to) @@ -88,7 +88,7 @@ (do-template [<triangle> <trapezoid> <type> <ascending> <descending> <lt>] [(def: #export (<triangle> bottom middle top) (-> <type> <type> <type> (Fuzzy <type>)) - (case (list;sort <lt> (list bottom middle top)) + (case (list.sort <lt> (list bottom middle top)) (^ (list bottom middle top)) (intersection (<ascending> bottom middle) (<descending> middle top)) @@ -98,7 +98,7 @@ (def: #export (<trapezoid> bottom middle-bottom middle-top top) (-> <type> <type> <type> <type> (Fuzzy <type>)) - (case (list;sort <lt> (list bottom middle-bottom middle-top top)) + (case (list.sort <lt> (list bottom middle-bottom middle-top top)) (^ (list bottom middle-bottom middle-top top)) (intersection (<ascending> bottom middle-bottom) (<descending> middle-top top)) @@ -113,15 +113,15 @@ (def: #export (gaussian deviation center) (-> Frac Frac (Fuzzy Frac)) (function [elem] - (let [scale (|> deviation (math;pow 2.0) (f/* 2.0)) + (let [scale (|> deviation (math.pow 2.0) (f/* 2.0)) membership (|> elem (f/- center) - (math;pow 2.0) + (math.pow 2.0) (f/* -1.0) (f// scale) - math;exp)] + math.exp)] (if (f/= 1.0 membership) - &;~true + &.~true (frac-to-deg membership))))) (def: #export (cut treshold set) @@ -129,8 +129,8 @@ (function [elem] (let [membership (set elem)] (if (d/> treshold membership) - (|> membership (d/- treshold) (d/* &;~true)) - &;~false)))) + (|> membership (d/- treshold) (d/* &.~true)) + &.~false)))) (def: #export (to-predicate treshold set) (All [a] (-> Deg (Fuzzy a) (-> a Bool))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index e8b552b1c..e3c7fd751 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Pseudo-random number generation (PRNG) algorithms."} +(.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."} [lux #- list] (lux (control [functor #+ Functor] [applicative #+ Applicative] @@ -21,11 +21,11 @@ )) (type: #export #rec PRNG - {#;doc "An abstract way to represent any PRNG."} + {#.doc "An abstract way to represent any PRNG."} (-> Unit [PRNG Nat])) (type: #export (Random a) - {#;doc "A producer of random values based on a PRNG."} + {#.doc "A producer of random values based on a PRNG."} (-> PRNG [PRNG a])) (struct: #export _ (Functor Random) @@ -56,7 +56,7 @@ (fa state'))))) (def: #export (filter pred gen) - {#;doc "Retries the generator until the output satisfies a predicate."} + {#.doc "Retries the generator until the output satisfies a predicate."} (All [a] (-> (-> a Bool) (Random a) (Random a))) (do Monad<Random> [sample gen] @@ -69,7 +69,7 @@ (function [prng] (let [[prng left] (prng []) [prng right] (prng [])] - [prng (n/+ (bit;shift-left +32 left) + [prng (n/+ (bit.shift-left +32 left) right)]))) (def: #export int @@ -77,20 +77,20 @@ (function [prng] (let [[prng left] (prng []) [prng right] (prng [])] - [prng (nat-to-int (n/+ (bit;shift-left +32 left) + [prng (nat-to-int (n/+ (bit.shift-left +32 left) right))]))) (def: #export bool (Random Bool) (function [prng] (let [[prng output] (prng [])] - [prng (|> output (bit;and +1) (n/= +1))]))) + [prng (|> output (bit.and +1) (n/= +1))]))) (def: (bits n) (-> Nat (Random Nat)) (function [prng] (let [[prng output] (prng [])] - [prng (bit;shift-right (n/- n +64) output)]))) + [prng (bit.shift-right (n/- n +64) output)]))) (def: #export frac (Random Frac) @@ -98,10 +98,10 @@ [left (bits +26) right (bits +27)] (wrap (|> right - (n/+ (bit;shift-left +27 left)) + (n/+ (bit.shift-left +27 left)) nat-to-int int-to-frac - (f// (|> +1 (bit;shift-left +53) nat-to-int int-to-frac)))))) + (f// (|> +1 (bit.shift-left +53) nat-to-int int-to-frac)))))) (def: #export deg (Random Deg) @@ -114,7 +114,7 @@ (do Monad<Random> [x char-gen xs (text' char-gen (n/dec size))] - (wrap (text/compose (text;from-code x) xs))))) + (wrap (text/compose (text.from-code x) xs))))) (type: Char-Range [Nat Nat]) @@ -137,13 +137,13 @@ (-> Char-Range Nat Bool) (and (n/>= from char) (n/<= to char))) -(def: unicode-ceiling (n/inc (product;right CJK-Compatibility-Ideographs-Supplement))) +(def: unicode-ceiling (n/inc (product.right CJK-Compatibility-Ideographs-Supplement))) (def: #export unicode (Random Nat) - (|> ;;nat + (|> ..nat (:: Monad<Random> map (n/% unicode-ceiling)) - (;;filter (function [raw] + (..filter (function [raw] ## From "Basic Latin" to "Syriac" (or (n/<= (hex "+074F") raw) (within? Thaana raw) @@ -208,12 +208,12 @@ right <gen>] (wrap (<ctor> left right))))] - [ratio r;Ratio r;ratio nat] - [complex c;Complex c;complex frac] + [ratio r.Ratio r.ratio nat] + [complex c.Complex c.complex frac] ) (def: #export (seq left right) - {#;doc "Sequencing combinator."} + {#.doc "Sequencing combinator."} (All [a b] (-> (Random a) (Random b) (Random [a b]))) (do Monad<Random> [=left left @@ -221,7 +221,7 @@ (wrap [=left =right]))) (def: #export (alt left right) - {#;doc "Heterogeneous alternative combinator."} + {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Random a) (Random b) (Random (| a b)))) (do Monad<Random> [? bool] @@ -234,7 +234,7 @@ (wrap (+1 =right)))))) (def: #export (either left right) - {#;doc "Homogeneous alternative combinator."} + {#.doc "Homogeneous alternative combinator."} (All [a] (-> (Random a) (Random a) (Random a))) (do Monad<Random> [? bool] @@ -243,7 +243,7 @@ right))) (def: #export (rec gen) - {#;doc "A combinator for producing recursive random generators."} + {#.doc "A combinator for producing recursive random generators."} (All [a] (-> (-> (Random a) (Random a)) (Random a))) (function [state] (let [gen' (gen (rec gen))] @@ -256,8 +256,8 @@ (if some? (do @ [value value-gen] - (wrap (#;Some value))) - (wrap #;None)))) + (wrap (#.Some value))) + (wrap #.None)))) (do-template [<name> <type> <zero> <plus>] [(def: #export (<name> size value-gen) @@ -269,8 +269,8 @@ (wrap (<plus> x xs))) (:: Monad<Random> wrap <zero>)))] - [list List (;list) #;Cons] - [sequence Sequence sequence;empty sequence;add] + [list List (.list) #.Cons] + [sequence Sequence sequence.empty sequence.add] ) (do-template [<name> <type> <ctor>] @@ -280,9 +280,9 @@ [values (list size value-gen)] (wrap (|> values <ctor>))))] - [array Array array;from-list] - [queue Queue queue;from-list] - [stack Stack (list/fold stack;push stack;empty)] + [array Array array.from-list] + [queue Queue queue.from-list] + [stack Stack (list/fold stack.push stack.empty)] ) (def: #export (set Hash<a> size value-gen) @@ -293,11 +293,11 @@ (loop [_ []] (do @ [x value-gen - #let [xs+ (set;add x xs)]] - (if (n/= size (set;size xs+)) + #let [xs+ (set.add x xs)]] + (if (n/= size (set.size xs+)) (wrap xs+) (recur []))))) - (:: Monad<Random> wrap (set;new Hash<a>)))) + (:: Monad<Random> wrap (set.new Hash<a>)))) (def: #export (dict Hash<a> size key-gen value-gen) (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dict k v)))) @@ -308,11 +308,11 @@ (do @ [k key-gen v value-gen - #let [kv+ (dict;put k v kv)]] - (if (n/= size (dict;size kv+)) + #let [kv+ (dict.put k v kv)]] + (if (n/= size (dict.size kv+)) (wrap kv+) (recur []))))) - (:: Monad<Random> wrap (dict;new Hash<a>)))) + (:: Monad<Random> wrap (dict.new Hash<a>)))) (def: #export (run prng calc) (All [a] (-> PRNG (Random a) [PRNG a])) @@ -321,49 +321,49 @@ (def: pcg-32-magic-mult Nat +6364136223846793005) (def: #export (pcg-32 [inc seed]) - {#;doc "An implementation of the PCG32 algorithm. + {#.doc "An implementation of the PCG32 algorithm. For more information, please see: http://www.pcg-random.org/"} (-> [Nat Nat] PRNG) (function [_] (let [seed' (|> seed (n/* pcg-32-magic-mult) (n/+ inc)) - xor-shifted (|> seed (bit;shift-right +18) (bit;xor seed) (bit;shift-right +27)) - rot (|> seed (bit;shift-right +59))] - [(pcg-32 [inc seed']) (bit;rotate-right rot xor-shifted)] + xor-shifted (|> seed (bit.shift-right +18) (bit.xor seed) (bit.shift-right +27)) + rot (|> seed (bit.shift-right +59))] + [(pcg-32 [inc seed']) (bit.rotate-right rot xor-shifted)] ))) (def: #export (xoroshiro-128+ [s0 s1]) - {#;doc "An implementation of the Xoroshiro128+ algorithm. + {#.doc "An implementation of the Xoroshiro128+ algorithm. For more information, please see: http://xoroshiro.di.unimi.it/"} (-> [Nat Nat] PRNG) (function [_] (let [result (n/+ s0 s1) - s01 (bit;xor s0 s1) - s0' (|> (bit;rotate-left +55 s0) - (bit;xor s01) - (bit;xor (bit;shift-left +14 s01))) - s1' (bit;rotate-left +36 s01)] + s01 (bit.xor s0 s1) + s0' (|> (bit.rotate-left +55 s0) + (bit.xor s01) + (bit.xor (bit.shift-left +14 s01))) + s1' (bit.rotate-left +36 s01)] [(xoroshiro-128+ [s0' s1']) result]) )) (def: (swap from to vec) (All [a] (-> Nat Nat (Sequence a) (Sequence a))) (|> vec - (sequence;put to (maybe;assume (sequence;nth from vec))) - (sequence;put from (maybe;assume (sequence;nth to vec))))) + (sequence.put to (maybe.assume (sequence.nth from vec))) + (sequence.put from (maybe.assume (sequence.nth to vec))))) (def: #export (shuffle seed sequence) - {#;doc "Shuffle a sequence randomly based on a seed value."} + {#.doc "Shuffle a sequence randomly based on a seed value."} (All [a] (-> Nat (Sequence a) (Sequence a))) - (let [_size (sequence;size sequence) - _shuffle (monad;fold Monad<Random> + (let [_size (sequence.size sequence) + _shuffle (monad.fold Monad<Random> (function [idx vec] (do Monad<Random> [rand nat] (wrap (swap idx (n/% _size rand) vec)))) sequence - (list;n/range +0 (n/dec _size)))] + (list.n/range +0 (n/dec _size)))] (|> _shuffle (run (pcg-32 [+123 seed])) - product;right))) + product.right))) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 9a43645e5..69cfbb647 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Tools for unit & property-based/generative testing."} +(.module: {#.doc "Tools for unit & property-based/generative testing."} lux (lux [macro #+ with-gensyms] (macro ["s" syntax #+ syntax: Syntax] @@ -30,16 +30,16 @@ (type: #export Counters [Nat Nat]) (type: #export Seed - {#;doc "The seed value used for random testing (if that feature is used)."} + {#.doc "The seed value used for random testing (if that feature is used)."} Nat) (type: #export Test - (r;Random (Promise [Counters Text]))) + (r.Random (Promise [Counters Text]))) (def: pcg-32-magic-inc Nat +12345) ## [Values] -(def: #hidden Monad<Random> (Monad r;Random) r;Monad<Random>) +(def: #hidden Monad<Random> (Monad r.Random) r.Monad<Random>) (def: success Counters [+1 +0]) (def: failure Counters [+0 +1]) @@ -53,19 +53,19 @@ (All [a] (-> Text Test)) (|> [failure (format " [Error] " message)] (:: Monad<Promise> wrap) - (:: r;Monad<Random> wrap))) + (:: r.Monad<Random> wrap))) (def: #export (assert message condition) - {#;doc "Check that a condition is true, and fail with the given message otherwise."} + {#.doc "Check that a condition is true, and fail with the given message otherwise."} (-> Text Bool (Promise [Counters Text])) (if condition (:: Monad<Promise> wrap [success (format "[Success] " message)]) (:: Monad<Promise> wrap [failure (format " [Error] " message)]))) (def: #export (test message condition) - {#;doc "Check that a condition is true, and fail with the given message otherwise."} + {#.doc "Check that a condition is true, and fail with the given message otherwise."} (-> Text Bool Test) - (:: r;Monad<Random> wrap (assert message condition))) + (:: r.Monad<Random> wrap (assert message condition))) (def: #hidden (run' tests) (-> (List [Text (IO Test) Text]) (Promise Counters)) @@ -74,29 +74,29 @@ (list/map (: (-> [Text (IO Test) Text] (Promise Counters)) (function [[module test description]] (do @ - [#let [pre (io;run instant;now) - seed (int-to-nat (instant;to-millis pre))] - [counters documentation] (|> (io;run test) - (r;run (r;pcg-32 [pcg-32-magic-inc seed])) - product;right) - #let [post (io;run instant;now) + [#let [pre (io.run instant.now) + seed (int-to-nat (instant.to-millis pre))] + [counters documentation] (|> (io.run test) + (r.run (r.pcg-32 [pcg-32-magic-inc seed])) + product.right) + #let [post (io.run instant.now) _ (log! (format "@ " module " " - "(" (%i (duration;to-millis (instant;span pre post))) "ms" ")" + "(" (%i (duration.to-millis (instant.span pre post))) "ms" ")" "\n" description "\n" "\n" documentation "\n"))]] (wrap counters))))) - (monad;seq @))] + (monad.seq @))] (wrap (list/fold add-counters start test-runs)))) (def: failed? (-> Counters Bool) - (|>> product;right (n/> +0))) + (|>> product.right (n/> +0))) (def: #export (seed value test) (-> Seed Test Test) (function [prng] - (let [[_ result] (r;run (r;pcg-32 [pcg-32-magic-inc value]) + (let [[_ result] (r.run (r.pcg-32 [pcg-32-magic-inc value]) test)] [prng result]))) @@ -109,21 +109,21 @@ test ## else - (do r;Monad<Random> - [seed r;nat] + (do r.Monad<Random> + [seed r.nat] (function [prng] - (let [[prng' instance] (r;run (r;pcg-32 [pcg-32-magic-inc seed]) test)] + (let [[prng' instance] (r.run (r.pcg-32 [pcg-32-magic-inc seed]) test)] [prng' (do Monad<Promise> [[counters documentation] instance] (if (failed? counters) (wrap [counters (format "Failed with this seed: " (%n seed) "\n" documentation)]) - (product;right (r;run prng' (times (n/dec amount) test)))))]))))) + (product.right (r.run prng' (times (n/dec amount) test)))))]))))) ## [Syntax] -(def: #hidden _code/text_ code;text) +(def: #hidden _code/text_ code.text) (syntax: #export (context: description test) - {#;doc (doc "Macro for definint tests." + {#.doc (doc "Macro for definint tests." (context: "Simple macros and constructs" ($_ seq (test "Can write easy loops for iterative programming." @@ -136,25 +136,25 @@ (test "Can create lists easily through macros." (and (case (list 1 2 3) - (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) + (#.Cons 1 (#.Cons 2 (#.Cons 3 #.Nil))) true _ false) (case (list& 1 2 3 (list 4 5 6)) - (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil)))))) + (#.Cons 1 (#.Cons 2 (#.Cons 3 (#.Cons 4 (#.Cons 5 (#.Cons 6 #.Nil)))))) true _ false))) (test "Can have defaults for Maybe values." - (and (is "yolo" (maybe;default "yolo" - #;None)) + (and (is "yolo" (maybe.default "yolo" + #.None)) - (is "lol" (maybe;default "yolo" - (#;Some "lol"))))) + (is "lol" (maybe.default "yolo" + (#.Some "lol"))))) )) "Also works with random generation of values for property-based testing." @@ -188,50 +188,50 @@ )} (with-gensyms [g!context g!test g!error] (wrap (list (` (def: #export (~ g!context) - {#;;test (;;_code/text_ (~ description))} + {#..test (.._code/text_ (~ description))} (IO Test) - (io (case ("lux try" [(io (do ;;Monad<Random> [] (~ test)))]) - (#;Right (~ g!test)) + (io (case ("lux try" [(io (do ..Monad<Random> [] (~ test)))]) + (#.Right (~ g!test)) (~ g!test) - (#;Left (~ g!error)) - (;;fail (~ g!error)))))))))) + (#.Left (~ g!error)) + (..fail (~ g!error)))))))))) (def: (exported-tests module-name) (-> Text (Meta (List [Text Text Text]))) - (do macro;Monad<Meta> - [defs (macro;exports module-name)] + (do macro.Monad<Meta> + [defs (macro.exports module-name)] (wrap (|> defs (list/map (function [[def-name [_ def-anns _]]] - (case (macro;get-text-ann (ident-for #;;test) def-anns) - (#;Some description) + (case (macro.get-text-ann (ident-for #..test) def-anns) + (#.Some description) [true module-name def-name description] _ [false module-name def-name ""]))) - (list;filter product;left) - (list/map product;right))))) + (list.filter product.left) + (list/map product.right))))) -(def: #hidden _composeT_ (-> Text Text Text) (:: text;Monoid<Text> compose)) +(def: #hidden _composeT_ (-> Text Text Text) (:: text.Monoid<Text> compose)) (def: #hidden _%i_ (-> Int Text) %i) (syntax: #export (run) - {#;doc (doc "Runs all the tests defined on the current module, and in all imported modules." + {#.doc (doc "Runs all the tests defined on the current module, and in all imported modules." (run))} (with-gensyms [g!successes g!failures g!total-successes g!total-failures] (do @ - [current-module macro;current-module-name - modules (macro;imported-modules current-module) + [current-module macro.current-module-name + modules (macro.imported-modules current-module) tests (: (Meta (List [Text Text Text])) - (|> (#;Cons current-module modules) - list;reverse - (monad;map @ exported-tests) + (|> (#.Cons current-module modules) + list.reverse + (monad.map @ exported-tests) (:: @ map list/join))) #let [tests+ (list/map (function [[module-name test desc]] - (` [(~ (code;text module-name)) (~ (code;symbol [module-name test])) (~ (code;text desc))])) + (` [(~ (code.text module-name)) (~ (code.symbol [module-name test])) (~ (code.text desc))])) tests) - num-tests (list;size tests+) - groups (list;split-all promise;concurrency-level tests+)]] + num-tests (list.size tests+) + groups (list.split-all promise.concurrency-level tests+)]] (wrap (list (` (: (IO Unit) (io (exec (do Monad<Promise> [(~' #let) [(~ g!total-successes) +0 @@ -251,15 +251,15 @@ " tests passed." "\n" (_%i_ (nat-to-int (~ g!total-failures))) " tests failed.")) - (promise;future (if (n/> +0 (~ g!total-failures)) - ;;die - ;;exit)))) + (promise.future (if (n/> +0 (~ g!total-failures)) + ..die + ..exit)))) []))))))))) (def: #export (seq left right) - {#;doc "Sequencing combinator."} + {#.doc "Sequencing combinator."} (-> Test Test Test) - (do r;Monad<Random> + (do r.Monad<Random> [left left right right] (wrap (do Monad<Promise> diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 36719b45f..61c73835a 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control eq order @@ -195,7 +195,7 @@ (n/= (get@ #day reference) (get@ #day sample))))) -(def: (date.< reference sample) +(def: (date/< reference sample) (-> Date Date Bool) (or (i/< (get@ #year reference) (get@ #year sample)) @@ -207,14 +207,14 @@ (struct: #export _ (Order Date) (def: eq Eq<Date>) - (def: < date.<) + (def: < date/<) (def: (> reference sample) - (date.< sample reference)) + (date/< sample reference)) (def: (<= reference sample) - (or (date.< reference sample) + (or (date/< reference sample) (:: Eq<Date> = reference sample))) (def: (>= reference sample) - (or (date.< sample reference) + (or (date/< sample reference) (:: Eq<Date> = sample reference)))) ## Based on this: https://stackoverflow.com/a/42936293/6823464 @@ -232,18 +232,18 @@ (pad (|> day nat-to-int)))) (def: lex-year - (l;Lexer Int) - (do p;Monad<Parser> - [sign? (p;maybe (l;this "-")) - raw-year (p;codec number;Codec<Text,Int> (l;many l;decimal)) + (l.Lexer Int) + (do p.Monad<Parser> + [sign? (p.maybe (l.this "-")) + raw-year (p.codec number.Codec<Text,Int> (l.many l.decimal)) #let [signum (case sign? - #;None 1 - (#;Some _) -1)]] + #.None 1 + (#.Some _) -1)]] (wrap (i/* signum raw-year)))) (def: lex-section - (l;Lexer Int) - (p;codec number;Codec<Text,Int> (l;exactly +2 l;decimal))) + (l.Lexer Int) + (p.codec number.Codec<Text,Int> (l.exactly +2 l.decimal))) (def: (leap-years year) (-> Int Int) @@ -260,7 +260,7 @@ (def: leap-year-months (Sequence Nat) - (sequence;update [+1] n/inc normal-months)) + (sequence.update [+1] n/inc normal-months)) (def: (divisible? factor input) (-> Int Int Bool) @@ -274,23 +274,23 @@ ## Based on: https://stackoverflow.com/a/3309340/6823464 (def: lex-date - (l;Lexer Date) - (do p;Monad<Parser> + (l.Lexer Date) + (do p.Monad<Parser> [utc-year lex-year - _ (l;this "-") + _ (l.this "-") utc-month lex-section - _ (p;assert "Invalid month." + _ (p.assert "Invalid month." (and (i/>= 1 utc-month) (i/<= 12 utc-month))) #let [months (if (leap-year? utc-year) leap-year-months normal-months) month-days (|> months - (sequence;nth (int-to-nat (i/dec utc-month))) - maybe;assume)] - _ (l;this "-") + (sequence.nth (int-to-nat (i/dec utc-month))) + maybe.assume)] + _ (l.this "-") utc-day lex-section - _ (p;assert "Invalid day." + _ (p.assert "Invalid day." (and (i/>= 1 utc-day) (i/<= (nat-to-int month-days) utc-day)))] (wrap {#year utc-year @@ -311,11 +311,11 @@ #day (int-to-nat utc-day)}))) (def: (decode input) - (-> Text (e;Error Date)) - (l;run input lex-date)) + (-> Text (e.Error Date)) + (l.run input lex-date)) (struct: #export _ - {#;doc "Based on ISO 8601. + {#.doc "Based on ISO 8601. For example: 2017-01-15"} (Codec Text Date) diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index b97ae817a..01d7f5847 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control eq order @@ -12,7 +12,7 @@ (type opaque))) (opaque: #export Duration - {#;doc "Durations have a resolution of milliseconds."} + {#.doc "Durations have a resolution of milliseconds."} Int (def: #export from-millis @@ -102,28 +102,28 @@ )))) (def: (lex-section suffix) - (-> Text (l;Lexer Int)) - (|> (p;codec number;Codec<Text,Int> (l;many l;decimal)) - (p;before (p;seq (l;this suffix) (p;not l;alpha))) - (p;default 0))) + (-> Text (l.Lexer Int)) + (|> (p.codec number.Codec<Text,Int> (l.many l.decimal)) + (p.before (p.seq (l.this suffix) (p.not l.alpha))) + (p.default 0))) (def: lex-duration - (l;Lexer Duration) - (do p;Monad<Parser> - [signed? (l;this? "-") + (l.Lexer Duration) + (do p.Monad<Parser> + [signed? (l.this? "-") #let [sign (function [raw] (if signed? (i/* -1 raw) raw))] utc-day (lex-section "D") utc-hour (lex-section "h") utc-minute (lex-section "m") - _ (p;assert "Invalid minute." + _ (p.assert "Invalid minute." (and (i/>= 0 utc-minute) (i/<= 59 utc-minute))) utc-second (lex-section "s") - _ (p;assert "Invalid second." + _ (p.assert "Invalid second." (and (i/>= 0 utc-second) (i/<= 59 utc-second))) utc-millis (lex-section "ms") - _ (p;assert "Invalid milli-seconds." + _ (p.assert "Invalid milli-seconds." (and (i/>= 0 utc-millis) (i/<= 999 utc-millis)))] (wrap (|> empty @@ -134,11 +134,11 @@ (merge (scale (sign utc-millis) milli)))))) (def: (decode input) - (-> Text (e;Error Duration)) - (l;run input lex-duration)) + (-> Text (e.Error Duration)) + (l.run input lex-duration)) (struct: #export _ - {#;doc "For example: 15D21h14m51s827ms"} + {#.doc "For example: 15D21h14m51s827ms"} (Codec Text Duration) (def: encode encode) (def: decode decode)) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 1175d4c75..1285e50e6 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io #- run] (control eq @@ -19,7 +19,7 @@ [date])) (opaque: #export Instant - {#;doc "Instant is defined as milliseconds since the epoch."} + {#.doc "Instant is defined as milliseconds since the epoch."} Int (def: #export from-millis @@ -31,30 +31,30 @@ (|>> @repr)) (def: #export (span from to) - (-> Instant Instant duration;Duration) - (duration;from-millis (i/- (@repr from) (@repr to)))) + (-> Instant Instant duration.Duration) + (duration.from-millis (i/- (@repr from) (@repr to)))) (def: #export (shift duration instant) - (-> duration;Duration Instant Instant) - (@opaque (i/+ (duration;to-millis duration) (@repr instant)))) + (-> duration.Duration Instant Instant) + (@opaque (i/+ (duration.to-millis duration) (@repr instant)))) (def: #export (relative instant) - (-> Instant duration;Duration) - (|> instant @repr duration;from-millis)) + (-> Instant duration.Duration) + (|> instant @repr duration.from-millis)) (def: #export (absolute offset) - (-> duration;Duration Instant) - (|> offset duration;to-millis @opaque)) + (-> duration.Duration Instant) + (|> offset duration.to-millis @opaque)) (struct: #export _ (Eq Instant) (def: (= param subject) - (:: number;Eq<Int> = (@repr param) (@repr subject)))) + (:: number.Eq<Int> = (@repr param) (@repr subject)))) (struct: #export _ (Order Instant) (def: eq Eq<Instant>) (do-template [<name>] [(def: (<name> param subject) - (:: number;Order<Int> <name> (@repr param) (@repr subject)))] + (:: number.Order<Int> <name> (@repr param) (@repr subject)))] [<] [<=] [>] [>=] )) @@ -63,14 +63,14 @@ (def: order Order<Instant>) (do-template [<name>] [(def: <name> - (|>> @repr (:: number;Enum<Int> <name>) @opaque))] + (|>> @repr (:: number.Enum<Int> <name>) @opaque))] [succ] [pred] )) ) (def: #export epoch - {#;doc "The instant corresponding to 1970-01-01T00:00:00Z"} + {#.doc "The instant corresponding to 1970-01-01T00:00:00Z"} Instant (from-millis 0)) @@ -88,17 +88,17 @@ (def: epoch-year Int 1970) (def: (find-year now) - (-> Instant [Int duration;Duration]) + (-> Instant [Int duration.Duration]) (loop [reference epoch-year time-left (relative now)] (let [year (if (leap-year? reference) - duration;leap-year - duration;normal-year)] - (if (i/= 0 (duration;query year time-left)) + duration.leap-year + duration.normal-year)] + (if (i/= 0 (duration.query year time-left)) [reference time-left] - (if (duration/>= duration;empty time-left) - (recur (i/inc reference) (duration;merge (duration;scale -1 year) time-left)) - (recur (i/dec reference) (duration;merge year time-left))) + (if (duration/>= duration.empty time-left) + (recur (i/inc reference) (duration.merge (duration.scale -1 year) time-left)) + (recur (i/dec reference) (duration.merge year time-left))) )))) (def: normal-months @@ -110,25 +110,25 @@ (def: leap-year-months (Sequence Nat) - (sequence;update [+1] n/inc normal-months)) + (sequence.update [+1] n/inc normal-months)) (def: (find-month months time) - (-> (Sequence Nat) duration;Duration [Nat duration;Duration]) - (if (duration/>= duration;empty time) + (-> (Sequence Nat) duration.Duration [Nat duration.Duration]) + (if (duration/>= duration.empty time) (sequence/fold (function [month-days [current-month time-left]] - (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] - (if (i/= 0 (duration;query month-duration time-left)) + (let [month-duration (duration.scale (nat-to-int month-days) duration.day)] + (if (i/= 0 (duration.query month-duration time-left)) [current-month time-left] - [(n/inc current-month) (duration;merge (duration;scale -1 month-duration) time-left)]))) + [(n/inc current-month) (duration.merge (duration.scale -1 month-duration) time-left)]))) [+0 time] months) (sequence/fold (function [month-days [current-month time-left]] - (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] - (if (i/= 0 (duration;query month-duration time-left)) + (let [month-duration (duration.scale (nat-to-int month-days) duration.day)] + (if (i/= 0 (duration.query month-duration time-left)) [current-month time-left] - [(n/dec current-month) (duration;merge month-duration time-left)]))) + [(n/dec current-month) (duration.merge month-duration time-left)]))) [+11 time] - (sequence;reverse months)))) + (sequence.reverse months)))) (def: (pad value) (-> Int Text) @@ -137,9 +137,9 @@ (int/encode value))) (def: (adjust-negative space duration) - (-> duration;Duration duration;Duration duration;Duration) - (if (duration;negative? duration) - (duration;merge space duration) + (-> duration.Duration duration.Duration duration.Duration) + (if (duration.negative? duration) + (duration.merge space duration) duration)) (def: (encode-millis millis) @@ -150,13 +150,13 @@ ## (i/< 1_000 millis) ($_ text/compose "." (int/encode millis)))) -(def: seconds-per-day Int (duration;query duration;second duration;day)) +(def: seconds-per-day Int (duration.query duration.second duration.day)) (def: days-up-to-epoch Int 719468) (def: (extract-date instant) - (-> Instant [[Int Int Int] duration;Duration]) + (-> Instant [[Int Int Int] duration.Duration]) (let [offset (relative instant) - seconds (duration;query duration;second offset) + seconds (duration.query duration.second offset) z (|> seconds (i// seconds-per-day) (i/+ days-up-to-epoch)) era (i// 146097 (if (i/>= 0 z) @@ -173,8 +173,8 @@ (i/- (|> (i/* 365 years-of-era) (i/+ (i// 4 years-of-era)) (i/- (i// 100 years-of-era))))) - day-time (duration;frame duration;day offset) - days-of-year (if (duration/>= duration;empty day-time) + day-time (duration.frame duration.day offset) + days-of-year (if (duration/>= duration.empty day-time) days-of-year (i/dec days-of-year)) mp (|> days-of-year (i/* 5) (i/+ 2) (i// 153)) @@ -195,42 +195,42 @@ (def: (encode instant) (-> Instant Text) (let [[[year month day] day-time] (extract-date instant) - day-time (if (duration/>= duration;empty day-time) + day-time (if (duration/>= duration.empty day-time) day-time - (duration;merge duration;day day-time)) - [hours day-time] [(duration;query duration;hour day-time) (duration;frame duration;hour day-time)] - [minutes day-time] [(duration;query duration;minute day-time) (duration;frame duration;minute day-time)] - [seconds millis] [(duration;query duration;second day-time) (duration;frame duration;second day-time)] + (duration.merge duration.day day-time)) + [hours day-time] [(duration.query duration.hour day-time) (duration.frame duration.hour day-time)] + [minutes day-time] [(duration.query duration.minute day-time) (duration.frame duration.minute day-time)] + [seconds millis] [(duration.query duration.second day-time) (duration.frame duration.second day-time)] ] ($_ text/compose (int/encode year) "-" (pad month) "-" (pad day) "T" (pad hours) ":" (pad minutes) ":" (pad seconds) (|> millis - (adjust-negative duration;second) - duration;to-millis + (adjust-negative duration.second) + duration.to-millis encode-millis) "Z"))) ## Codec::decode (def: lex-year - (l;Lexer Int) - (do p;Monad<Parser> - [sign? (p;maybe (l;this "-")) - raw-year (p;codec number;Codec<Text,Int> (l;many l;decimal)) + (l.Lexer Int) + (do p.Monad<Parser> + [sign? (p.maybe (l.this "-")) + raw-year (p.codec number.Codec<Text,Int> (l.many l.decimal)) #let [signum (case sign? - #;None 1 - (#;Some _) -1)]] + #.None 1 + (#.Some _) -1)]] (wrap (i/* signum raw-year)))) (def: lex-section - (l;Lexer Int) - (p;codec number;Codec<Text,Int> (l;exactly +2 l;decimal))) + (l.Lexer Int) + (p.codec number.Codec<Text,Int> (l.exactly +2 l.decimal))) (def: lex-millis - (l;Lexer Int) - (p;either (|> (l;at-most +3 l;decimal) - (p;codec number;Codec<Text,Int>) - (p;after (l;this "."))) - (:: p;Monad<Parser> wrap 0))) + (l.Lexer Int) + (p.either (|> (l.at-most +3 l.decimal) + (p.codec number.Codec<Text,Int>) + (p.after (l.this "."))) + (:: p.Monad<Parser> wrap 0))) (def: (leap-years year) (-> Int Int) @@ -240,67 +240,67 @@ ## Based on: https://stackoverflow.com/a/3309340/6823464 (def: lex-instant - (l;Lexer Instant) - (do p;Monad<Parser> + (l.Lexer Instant) + (do p.Monad<Parser> [utc-year lex-year - _ (l;this "-") + _ (l.this "-") utc-month lex-section - _ (p;assert "Invalid month." + _ (p.assert "Invalid month." (and (i/>= 1 utc-month) (i/<= 12 utc-month))) #let [months (if (leap-year? utc-year) leap-year-months normal-months) month-days (|> months - (sequence;nth (int-to-nat (i/dec utc-month))) - maybe;assume)] - _ (l;this "-") + (sequence.nth (int-to-nat (i/dec utc-month))) + maybe.assume)] + _ (l.this "-") utc-day lex-section - _ (p;assert "Invalid day." + _ (p.assert "Invalid day." (and (i/>= 1 utc-day) (i/<= (nat-to-int month-days) utc-day))) - _ (l;this "T") + _ (l.this "T") utc-hour lex-section - _ (p;assert "Invalid hour." + _ (p.assert "Invalid hour." (and (i/>= 0 utc-hour) (i/<= 23 utc-hour))) - _ (l;this ":") + _ (l.this ":") utc-minute lex-section - _ (p;assert "Invalid minute." + _ (p.assert "Invalid minute." (and (i/>= 0 utc-minute) (i/<= 59 utc-minute))) - _ (l;this ":") + _ (l.this ":") utc-second lex-section - _ (p;assert "Invalid second." + _ (p.assert "Invalid second." (and (i/>= 0 utc-second) (i/<= 59 utc-second))) utc-millis lex-millis - _ (l;this "Z") + _ (l.this "Z") #let [years-since-epoch (i/- epoch-year utc-year) previous-leap-days (i/- (leap-years epoch-year) (leap-years (i/dec utc-year))) year-days-so-far (|> (i/* 365 years-since-epoch) (i/+ previous-leap-days)) month-days-so-far (|> months - sequence;to-list - (list;take (int-to-nat (i/dec utc-month))) + sequence.to-list + (list.take (int-to-nat (i/dec utc-month))) (L/fold n/+ +0)) total-days (|> year-days-so-far (i/+ (nat-to-int month-days-so-far)) (i/+ (i/dec utc-day)))]] (wrap (|> epoch - (shift (duration;scale total-days duration;day)) - (shift (duration;scale utc-hour duration;hour)) - (shift (duration;scale utc-minute duration;minute)) - (shift (duration;scale utc-second duration;second)) - (shift (duration;scale utc-millis duration;milli)))))) + (shift (duration.scale total-days duration.day)) + (shift (duration.scale utc-hour duration.hour)) + (shift (duration.scale utc-minute duration.minute)) + (shift (duration.scale utc-second duration.second)) + (shift (duration.scale utc-millis duration.milli)))))) (def: (decode input) - (-> Text (e;Error Instant)) - (l;run input lex-instant)) + (-> Text (e.Error Instant)) + (l.run input lex-instant)) (struct: #export _ - {#;doc "Based on ISO 8601. + {#.doc "Based on ISO 8601. For example: 2017-01-15T21:14:51.827Z"} (Codec Text Instant) @@ -312,37 +312,37 @@ (io (from-millis ("lux io current-time")))) (def: #export (date instant) - (-> Instant date;Date) + (-> Instant date.Date) (let [[[year month day] _] (extract-date instant)] - {#date;year year - #date;month (case (i/dec month) - 0 #date;January - 1 #date;February - 2 #date;March - 3 #date;April - 4 #date;May - 5 #date;June - 6 #date;July - 7 #date;August - 8 #date;September - 9 #date;October - 10 #date;November - 11 #date;December + {#date.year year + #date.month (case (i/dec month) + 0 #date.January + 1 #date.February + 2 #date.March + 3 #date.April + 4 #date.May + 5 #date.June + 6 #date.July + 7 #date.August + 8 #date.September + 9 #date.October + 10 #date.November + 11 #date.December _ (undefined)) - #date;day (int-to-nat day)})) + #date.day (int-to-nat day)})) (def: #export (month instant) - (-> Instant date;Month) + (-> Instant date.Month) (let [[year month day] (date instant)] month)) (def: #export (day instant) - (-> Instant date;Day) + (-> Instant date.Day) (let [offset (relative instant) - days (duration;query duration;day offset) - day-time (duration;frame duration;day offset) - days (if (and (duration;negative? offset) - (not (duration;neutral? day-time))) + days (duration.query duration.day offset) + day-time (duration.frame duration.day offset) + days (if (and (duration.negative? offset) + (not (duration.neutral? day-time))) (i/dec days) days) ## 1970/01/01 was a Thursday @@ -351,11 +351,11 @@ (i/+ days) (i/% 7) ## This is done to turn negative days into positive days. (i/+ 7) (i/% 7)) - 0 #date;Sunday - 1 #date;Monday - 2 #date;Tuesday - 3 #date;Wednesday - 4 #date;Thursday - 5 #date;Friday - 6 #date;Saturday + 0 #date.Sunday + 1 #date.Monday + 2 #date.Tuesday + 3 #date.Wednesday + 4 #date.Thursday + 5 #date.Friday + 6 #date.Saturday _ (undefined)))) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index fd772c103..39acf31ba 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] [eq] @@ -20,31 +20,31 @@ (def: (find-type-var id env) (-> Nat Type-Context (Meta Type)) - (case (list;find (|>> product;left (n/= id)) - (get@ #;var-bindings env)) - (#;Some [_ (#;Some type)]) + (case (list.find (|>> product.left (n/= id)) + (get@ #.var-bindings env)) + (#.Some [_ (#.Some type)]) (case type - (#;Var id') + (#.Var id') (find-type-var id' env) _ (:: Monad<Meta> wrap type)) - (#;Some [_ #;None]) - (macro;fail (format "Unbound type-var " (%n id))) + (#.Some [_ #.None]) + (macro.fail (format "Unbound type-var " (%n id))) - #;None - (macro;fail (format "Unknown type-var " (%n id))) + #.None + (macro.fail (format "Unknown type-var " (%n id))) )) (def: (resolve-type var-name) (-> Ident (Meta Type)) (do Monad<Meta> - [raw-type (macro;find-type var-name) - compiler macro;get-compiler] + [raw-type (macro.find-type var-name) + compiler macro.get-compiler] (case raw-type - (#;Var id) - (find-type-var id (get@ #;type-context compiler)) + (#.Var id) + (find-type-var id (get@ #.type-context compiler)) _ (wrap raw-type)))) @@ -52,18 +52,18 @@ (def: (find-member-type idx sig-type) (-> Nat Type (Check Type)) (case sig-type - (#;Named _ sig-type') + (#.Named _ sig-type') (find-member-type idx sig-type') - (#;Apply arg func) - (case (type;apply (list arg) func) - #;None - (tc;fail (format "Cannot apply type " (%type func) " to type " (%type arg))) + (#.Apply arg func) + (case (type.apply (list arg) func) + #.None + (tc.fail (format "Cannot apply type " (%type func) " to type " (%type arg))) - (#;Some sig-type') + (#.Some sig-type') (find-member-type idx sig-type')) - (#;Product left right) + (#.Product left right) (if (n/= +0 idx) (:: Monad<Check> wrap left) (find-member-type (n/dec idx) right)) @@ -71,32 +71,32 @@ _ (if (n/= +0 idx) (:: Monad<Check> wrap sig-type) - (tc;fail (format "Cannot find member type " (%n idx) " for " (%type sig-type)))))) + (tc.fail (format "Cannot find member type " (%n idx) " for " (%type sig-type)))))) (def: (find-member-name member) (-> Ident (Meta Ident)) (case member ["" simple-name] - (macro;either (do Monad<Meta> - [member (macro;normalize member) - _ (macro;resolve-tag member)] + (macro.either (do Monad<Meta> + [member (macro.normalize member) + _ (macro.resolve-tag member)] (wrap member)) (do Monad<Meta> - [this-module-name macro;current-module-name - imp-mods (macro;imported-modules this-module-name) - tag-lists (monad;map @ macro;tag-lists imp-mods) - #let [tag-lists (|> tag-lists list/join (list/map product;left) list/join) - candidates (list;filter (|>> product;right (text/= simple-name)) + [this-module-name macro.current-module-name + imp-mods (macro.imported-modules this-module-name) + tag-lists (monad.map @ macro.tag-lists imp-mods) + #let [tag-lists (|> tag-lists list/join (list/map product.left) list/join) + candidates (list.filter (|>> product.right (text/= simple-name)) tag-lists)]] (case candidates - #;Nil - (macro;fail (format "Unknown tag: " (%ident member))) + #.Nil + (macro.fail (format "Unknown tag: " (%ident member))) - (#;Cons winner #;Nil) + (#.Cons winner #.Nil) (wrap winner) _ - (macro;fail (format "Too many candidate tags: " (%list %ident candidates)))))) + (macro.fail (format "Too many candidate tags: " (%list %ident candidates)))))) _ (:: Monad<Meta> wrap member))) @@ -105,45 +105,45 @@ (-> Ident (Meta [Nat Type])) (do Monad<Meta> [member (find-member-name member) - [idx tag-list sig-type] (macro;resolve-tag member)] + [idx tag-list sig-type] (macro.resolve-tag member)] (wrap [idx sig-type]))) (def: (prepare-defs this-module-name defs) (-> Text (List [Text Def]) (List [Ident Type])) (|> defs - (list;filter (function [[name [def-type def-anns def-value]]] - (macro;struct? def-anns))) + (list.filter (function [[name [def-type def-anns def-value]]] + (macro.struct? def-anns))) (list/map (function [[name [def-type def-anns def-value]]] [[this-module-name name] def-type])))) (def: local-env (Meta (List [Ident Type])) (do Monad<Meta> - [local-batches macro;locals + [local-batches macro.locals #let [total-locals (list/fold (function [[name type] table] - (dict;put~ name type table)) - (: (dict;Dict Text Type) - (dict;new text;Hash<Text>)) + (dict.put~ name type table)) + (: (dict.Dict Text Type) + (dict.new text.Hash<Text>)) (list/join local-batches))]] (wrap (|> total-locals - dict;entries + dict.entries (list/map (function [[name type]] [["" name] type])))))) (def: local-structs (Meta (List [Ident Type])) (do Monad<Meta> - [this-module-name macro;current-module-name - defs (macro;defs this-module-name)] + [this-module-name macro.current-module-name + defs (macro.defs this-module-name)] (wrap (prepare-defs this-module-name defs)))) (def: import-structs (Meta (List [Ident Type])) (do Monad<Meta> - [this-module-name macro;current-module-name - imp-mods (macro;imported-modules this-module-name) - export-batches (monad;map @ (function [imp-mod] + [this-module-name macro.current-module-name + imp-mods (macro.imported-modules this-module-name) + export-batches (monad.map @ (function [imp-mod] (do @ - [exports (macro;exports imp-mod)] + [exports (macro.exports imp-mod)] (wrap (prepare-defs imp-mod exports)))) imp-mods)] (wrap (list/join export-batches)))) @@ -151,31 +151,31 @@ (def: (apply-function-type func arg) (-> Type Type (Check Type)) (case func - (#;Named _ func') + (#.Named _ func') (apply-function-type func' arg) - (#;UnivQ _) + (#.UnivQ _) (do Monad<Check> - [[id var] tc;var] - (apply-function-type (maybe;assume (type;apply (list var) func)) + [[id var] tc.var] + (apply-function-type (maybe.assume (type.apply (list var) func)) arg)) - (#;Function input output) + (#.Function input output) (do Monad<Check> - [_ (tc;check input arg)] + [_ (tc.check input arg)] (wrap output)) _ - (tc;fail (format "Invalid function type: " (%type func))))) + (tc.fail (format "Invalid function type: " (%type func))))) (def: (concrete-type type) (-> Type (Check [(List Nat) Type])) (case type - (#;UnivQ _) + (#.UnivQ _) (do Monad<Check> - [[id var] tc;var - [ids final-output] (concrete-type (maybe;assume (type;apply (list var) type)))] - (wrap [(#;Cons id ids) + [[id var] tc.var + [ids final-output] (concrete-type (maybe.assume (type.apply (list var) type)))] + (wrap [(#.Cons id ids) final-output])) _ @@ -184,12 +184,12 @@ (def: (check-apply member-type input-types output-type) (-> Type (List Type) Type (Check [])) (do Monad<Check> - [member-type' (monad;fold Monad<Check> + [member-type' (monad.fold Monad<Check> (function [input member] (apply-function-type member input)) member-type input-types)] - (tc;check output-type member-type'))) + (tc.check output-type member-type'))) (type: #rec Instance {#constructor Ident @@ -200,76 +200,76 @@ Type-Context Type (List [Ident Type]) (Meta (List Instance))) (do Monad<Meta> - [compiler macro;get-compiler] + [compiler macro.get-compiler] (case (|> alts (list/map (function [[alt-name alt-type]] - (case (tc;run context + (case (tc.run context (do Monad<Check> [[tvars alt-type] (concrete-type alt-type) - #let [[deps alt-type] (type;flatten-function alt-type)] - _ (tc;check dep alt-type) - context' tc;get-context - =deps (monad;map @ (provision compiler context') deps)] + #let [[deps alt-type] (type.flatten-function alt-type)] + _ (tc.check dep alt-type) + context' tc.get-context + =deps (monad.map @ (provision compiler context') deps)] (wrap =deps))) - (#;Left error) + (#.Left error) (list) - (#;Right =deps) + (#.Right =deps) (list [alt-name =deps])))) list/join) - #;Nil - (macro;fail (format "No candidates for provisioning: " (%type dep))) + #.Nil + (macro.fail (format "No candidates for provisioning: " (%type dep))) found (wrap found)))) (def: (provision compiler context dep) (-> Compiler Type-Context Type (Check Instance)) - (case (macro;run compiler - ($_ macro;either + (case (macro.run compiler + ($_ macro.either (do Monad<Meta> [alts local-env] (test-provision provision context dep alts)) (do Monad<Meta> [alts local-structs] (test-provision provision context dep alts)) (do Monad<Meta> [alts import-structs] (test-provision provision context dep alts)))) - (#;Left error) - (tc;fail error) + (#.Left error) + (tc.fail error) - (#;Right candidates) + (#.Right candidates) (case candidates - #;Nil - (tc;fail (format "No candidates for provisioning: " (%type dep))) + #.Nil + (tc.fail (format "No candidates for provisioning: " (%type dep))) - (#;Cons winner #;Nil) + (#.Cons winner #.Nil) (:: Monad<Check> wrap winner) _ - (tc;fail (format "Too many candidates for provisioning: " (%type dep) " --- " (%list (|>> product;left %ident) candidates)))) + (tc.fail (format "Too many candidates for provisioning: " (%type dep) " --- " (%list (|>> product.left %ident) candidates)))) )) (def: (test-alternatives sig-type member-idx input-types output-type alts) (-> Type Nat (List Type) Type (List [Ident Type]) (Meta (List Instance))) (do Monad<Meta> - [compiler macro;get-compiler - context macro;type-context] + [compiler macro.get-compiler + context macro.type-context] (case (|> alts (list/map (function [[alt-name alt-type]] - (case (tc;run context + (case (tc.run context (do Monad<Check> [[tvars alt-type] (concrete-type alt-type) - #let [[deps alt-type] (type;flatten-function alt-type)] - _ (tc;check alt-type sig-type) + #let [[deps alt-type] (type.flatten-function alt-type)] + _ (tc.check alt-type sig-type) member-type (find-member-type member-idx alt-type) _ (check-apply member-type input-types output-type) - context' tc;get-context - =deps (monad;map @ (provision compiler context') deps)] + context' tc.get-context + =deps (monad.map @ (provision compiler context') deps)] (wrap =deps))) - (#;Left error) + (#.Left error) (list) - (#;Right =deps) + (#.Right =deps) (list [alt-name =deps])))) list/join) - #;Nil - (macro;fail (format "No alternatives for " (%type (type;function input-types output-type)))) + #.Nil + (macro.fail (format "No alternatives for " (%type (type.function input-types output-type)))) found (wrap found)))) @@ -277,7 +277,7 @@ (def: (find-alternatives sig-type member-idx input-types output-type) (-> Type Nat (List Type) Type (Meta (List Instance))) (let [test (test-alternatives sig-type member-idx input-types output-type)] - ($_ macro;either + ($_ macro.either (do Monad<Meta> [alts local-env] (test alts)) (do Monad<Meta> [alts local-structs] (test alts)) (do Monad<Meta> [alts import-structs] (test alts))))) @@ -285,7 +285,7 @@ (def: (var? input) (-> Code Bool) (case input - [_ (#;Symbol _)] + [_ (#.Symbol _)] true _ @@ -298,16 +298,16 @@ (def: (instance$ [constructor dependencies]) (-> Instance Code) (case dependencies - #;Nil - (code;symbol constructor) + #.Nil + (code.symbol constructor) _ - (` ((~ (code;symbol constructor)) (~@ (list/map instance$ dependencies)))))) + (` ((~ (code.symbol constructor)) (~@ (list/map instance$ dependencies)))))) -(syntax: #export (::: [member s;symbol] - [args (p;alt (p;seq (p;some s;symbol) s;end!) - (p;seq (p;some s;any) s;end!))]) - {#;doc (doc "Automatic structure selection (for type-class style polymorphism)." +(syntax: #export (::: [member s.symbol] + [args (p.alt (p.seq (p.some s.symbol) s.end!) + (p.seq (p.some s.any) s.end!))]) + {#.doc (doc "Automatic structure selection (for type-class style polymorphism)." "This feature layers type-class style polymorphism on top of Lux's signatures and structures." "When calling a polymorphic function, or using a polymorphic constant," "this macro will check the types of the arguments, and the expected type for the whole expression" @@ -318,46 +318,46 @@ "a compile-time error will be raised, to alert the user." "Examples:" "Nat equality" - (:: number;Eq<Nat> = x y) + (:: number.Eq<Nat> = x y) (::: = x y) "Can optionally add the prefix of the module where the signature was defined." - (::: eq;= x y) + (::: eq.= x y) "(List Nat) equality" (::: = - (list;n/range +1 +10) - (list;n/range +1 +10)) + (list.n/range +1 +10) + (list.n/range +1 +10)) "(Functor List) map" - (::: map n/inc (list;n/range +0 +9)) + (::: map n/inc (list.n/range +0 +9)) "Caveat emptor: You need to make sure to import the module of any structure you want to use." "Otherwise, this macro will not find it.")} (case args - (#;Left [args _]) + (#.Left [args _]) (do @ [[member-idx sig-type] (resolve-member member) - input-types (monad;map @ resolve-type args) - output-type macro;expected-type + input-types (monad.map @ resolve-type args) + output-type macro.expected-type chosen-ones (find-alternatives sig-type member-idx input-types output-type)] (case chosen-ones - #;Nil - (macro;fail (format "No structure option could be found for member: " (%ident member))) + #.Nil + (macro.fail (format "No structure option could be found for member: " (%ident member))) - (#;Cons chosen #;Nil) + (#.Cons chosen #.Nil) (wrap (list (` (:: (~ (instance$ chosen)) - (~ (code;local-symbol (product;right member))) - (~@ (list/map code;symbol args)))))) + (~ (code.local-symbol (product.right member))) + (~@ (list/map code.symbol args)))))) _ - (macro;fail (format "Too many options available: " + (macro.fail (format "Too many options available: " (|> chosen-ones - (list/map (|>> product;left %ident)) - (text;join-with ", ")) + (list/map (|>> product.left %ident)) + (text.join-with ", ")) " --- for type: " (%type sig-type))))) - (#;Right [args _]) + (#.Right [args _]) (do @ - [labels (monad;seq @ (list;repeat (list;size args) - (macro;gensym ""))) - #let [retry (` (let [(~@ (|> (list;zip2 labels args) (list/map join-pair) list/join))] - (;;::: (~ (code;symbol member)) (~@ labels))))]] + [labels (monad.seq @ (list.repeat (list.size args) + (macro.gensym ""))) + #let [retry (` (let [(~@ (|> (list.zip2 labels args) (list/map join-pair) list/join))] + (..::: (~ (code.symbol member)) (~@ labels))))]] (wrap (list retry))) )) diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index 881eaa1e5..ba4b06384 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["M" monad #+ do Monad] ["p" parser "p/" Monad<Parser>]) @@ -27,46 +27,46 @@ (def: (var-set vars) (-> (List Text) (Set Text)) - (set;from-list text;Hash<Text> vars)) + (set.from-list text.Hash<Text> vars)) (def: (unique-type-vars parser) - (-> (s;Syntax (List Text)) (s;Syntax (List Text))) - (do p;Monad<Parser> + (-> (s.Syntax (List Text)) (s.Syntax (List Text))) + (do p.Monad<Parser> [raw parser - _ (p;assert "Cannot repeat the names of type variables/parameters." - (n/= (set;size (var-set raw)) - (list;size raw)))] + _ (p.assert "Cannot repeat the names of type variables/parameters." + (n/= (set.size (var-set raw)) + (list.size raw)))] (wrap raw))) (def: (safe-type-vars exclusions) - (-> (Set Text) (s;Syntax Text)) - (do p;Monad<Parser> - [raw s;local-symbol - _ (p;assert "Cannot re-use names between method type-variables and interface type-parameters." - (|> raw (set;member? exclusions) not))] + (-> (Set Text) (s.Syntax Text)) + (do p.Monad<Parser> + [raw s.local-symbol + _ (p.assert "Cannot re-use names between method type-variables and interface type-parameters." + (|> raw (set.member? exclusions) not))] (wrap raw))) (def: declarationS - (s;Syntax Declaration) - (p;either (s;form (p;seq s;local-symbol - (unique-type-vars (p;some s;local-symbol)))) - (p;seq s;local-symbol + (s.Syntax Declaration) + (p.either (s.form (p.seq s.local-symbol + (unique-type-vars (p.some s.local-symbol)))) + (p.seq s.local-symbol (p/wrap (list))))) (def: aliasS - (s;Syntax Alias) - (|> s;local-symbol - (p;after (s;this (' #as))) - (p;default default-alias))) + (s.Syntax Alias) + (|> s.local-symbol + (p.after (s.this (' #as))) + (p.default default-alias))) (def: (ancestor-inputs ancestors) (-> (List Ident) (List Code)) - (if (list;empty? ancestors) + (if (list.empty? ancestors) (list) - (|> (list;size ancestors) + (|> (list.size ancestors) n/dec - (list;n/range +0) - (L/map (|>> %n (format "ancestor") code;local-symbol))))) + (list.n/range +0) + (L/map (|>> %n (format "ancestor") code.local-symbol))))) ## [Methods] (type: Method @@ -76,38 +76,38 @@ #output Code}) (def: (method exclusions) - (-> (Set Text) (s;Syntax Method)) - (s;form ($_ p;seq - (p;either (unique-type-vars (s;tuple (p;some (safe-type-vars exclusions)))) + (-> (Set Text) (s.Syntax Method)) + (s.form ($_ p.seq + (p.either (unique-type-vars (s.tuple (p.some (safe-type-vars exclusions)))) (p/wrap (list))) - s;local-symbol - (s;tuple (p;some s;any)) - s;any))) + s.local-symbol + (s.tuple (p.some s.any)) + s.any))) (def: (declarationM g!self (^open)) (-> Code Method Code) - (let [g!type-vars (L/map code;local-symbol type-vars) - g!method (code;local-symbol name)] + (let [g!type-vars (L/map code.local-symbol type-vars) + g!method (code.local-symbol name)] (` (: (All [(~@ g!type-vars)] (-> (~@ inputs) (~ g!self) (~ output))) (~ g!method))))) (def: (definition export [interface parameters] g!self-object g!ext g!states (^open)) - (-> (Maybe cs;Export) Declaration Code Code (List Code) Method Code) - (let [g!method (code;local-symbol name) - g!parameters (L/map code;local-symbol parameters) - g!type-vars (L/map code;local-symbol type-vars) - g!_temp (code;symbol ["" "_temp"]) - g!_object (code;symbol ["" "_object"]) - g!_behavior (code;symbol ["" "_behavior"]) - g!_state (code;symbol ["" "_state"]) - g!_extension (code;symbol ["" "_extension"]) - g!_args (L/map (|>> product;left nat-to-int %i (format "_") code;local-symbol) - (list;enumerate inputs)) + (-> (Maybe cs.Export) Declaration Code Code (List Code) Method Code) + (let [g!method (code.local-symbol name) + g!parameters (L/map code.local-symbol parameters) + g!type-vars (L/map code.local-symbol type-vars) + g!_temp (code.symbol ["" "_temp"]) + g!_object (code.symbol ["" "_object"]) + g!_behavior (code.symbol ["" "_behavior"]) + g!_state (code.symbol ["" "_state"]) + g!_extension (code.symbol ["" "_extension"]) + g!_args (L/map (|>> product.left nat-to-int %i (format "_") code.local-symbol) + (list.enumerate inputs)) g!destructuring (L/fold (function [_ g!bottom] (` [(~ g!_temp) (~ g!_temp) (~ g!bottom)])) (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]) - (maybe;default g!states (list;tail g!states)))] - (` (def: (~@ (csw;export export)) ((~ g!method) (~@ g!_args) (~ g!_object)) + (maybe.default g!states (list.tail g!states)))] + (` (def: (~@ (csw.export export)) ((~ g!method) (~@ g!_args) (~ g!_object)) (All [(~@ g!parameters) (~ g!ext) (~@ g!states) (~@ g!type-vars)] (-> (~@ inputs) (~ g!self-object) (~ output))) (let [(~ g!destructuring) (~ g!_object)] @@ -124,40 +124,40 @@ (Ident/= no-parent parent)) (def: (with-interface parent interface) - (-> Ident Ident cs;Annotations cs;Annotations) - (|>> (#;Cons [(ident-for #;;interface-name) - (code;tag interface)]) - (#;Cons [(ident-for #;;interface-parent) - (code;tag parent)]))) + (-> Ident Ident cs.Annotations cs.Annotations) + (|>> (#.Cons [(ident-for #..interface-name) + (code.tag interface)]) + (#.Cons [(ident-for #..interface-parent) + (code.tag parent)]))) (def: (with-class interface parent class) - (-> Ident Ident Ident cs;Annotations cs;Annotations) - (|>> (#;Cons [(ident-for #;;class-interface) - (code;tag interface)]) - (#;Cons [(ident-for #;;class-parent) - (code;tag parent)]) - (#;Cons [(ident-for #;;class-name) - (code;tag class)]))) + (-> Ident Ident Ident cs.Annotations cs.Annotations) + (|>> (#.Cons [(ident-for #..class-interface) + (code.tag interface)]) + (#.Cons [(ident-for #..class-parent) + (code.tag parent)]) + (#.Cons [(ident-for #..class-name) + (code.tag class)]))) (do-template [<name> <name-tag> <parent-tag> <desc>] [(def: (<name> name) (-> Ident (Meta [Ident (List Ident)])) (do Monad<Meta> - [[_ annotations _] (macro;find-def name)] - (case [(macro;get-tag-ann (ident-for <name-tag>) annotations) - (macro;get-tag-ann (ident-for <parent-tag>) annotations)] - [(#;Some real-name) (#;Some parent)] + [[_ annotations _] (macro.find-def name)] + (case [(macro.get-tag-ann (ident-for <name-tag>) annotations) + (macro.get-tag-ann (ident-for <parent-tag>) annotations)] + [(#.Some real-name) (#.Some parent)] (if (Ident/= no-parent parent) (wrap [real-name (list)]) (do @ [[_ ancestors] (<name> parent)] - (wrap [real-name (#;Cons parent ancestors)]))) + (wrap [real-name (#.Cons parent ancestors)]))) _ - (macro;fail (format "Wrong format for " <desc> " lineage.")))))] + (macro.fail (format "Wrong format for " <desc> " lineage.")))))] - [interfaceN #;;interface-name #;;interface-parent "interface"] - [classN #;;class-name #;;class-parent "class"] + [interfaceN #..interface-name #..interface-parent "interface"] + [classN #..class-name #..class-parent "class"] ) (def: (extract newT) @@ -165,43 +165,43 @@ (loop [depth +0 currentT newT] (case currentT - (#;UnivQ _ bodyT) + (#.UnivQ _ bodyT) (recur (n/inc depth) bodyT) - (#;Function inputT outputT) - (let [[stateT+ objectT] (type;flatten-function currentT)] + (#.Function inputT outputT) + (let [[stateT+ objectT] (type.flatten-function currentT)] (Macro/wrap [depth stateT+])) _ - (macro;fail (format "Cannot extract inheritance from type: " (type;to-text newT)))))) + (macro.fail (format "Cannot extract inheritance from type: " (type.to-text newT)))))) (def: (specialize mappings typeC) (-> (List Code) Code Code) - (case (list;size mappings) + (case (list.size mappings) +0 typeC size (|> (n/dec size) - (list;n/range +0) - (L/map (|>> (n/* +2) n/inc code;nat (~) #;Bound (`))) - (list;zip2 (list;reverse mappings)) + (list.n/range +0) + (L/map (|>> (n/* +2) n/inc code.nat (~) #.Bound (`))) + (list.zip2 (list.reverse mappings)) (L/fold (function [[mappingC boundC] genericC] - (code;replace boundC mappingC genericC)) + (code.replace boundC mappingC genericC)) typeC)))) (def: referenceS - (s;Syntax Reference) - (p;either (s;form (p;seq s;symbol - (p;some s;any))) - (p;seq s;symbol + (s.Syntax Reference) + (p.either (s.form (p.seq s.symbol + (p.some s.any))) + (p.seq s.symbol (p/wrap (list))))) (do-template [<name> <keyword>] [(def: <name> - (s;Syntax Reference) + (s.Syntax Reference) (|> referenceS - (p;after (s;this (' <keyword>)))))] + (p.after (s.this (' <keyword>)))))] [extension #super] [inheritance #super] @@ -212,11 +212,11 @@ (def: (nest ancestors bottom) (-> (List Code) Code Code) (L/fold (function [[level _] g!bottom] - (let [g!_behavior' (code;local-symbol (format "_behavior" (%n level))) - g!_state' (code;local-symbol (format "_state" (%n level)))] + (let [g!_behavior' (code.local-symbol (format "_behavior" (%n level))) + g!_state' (code.local-symbol (format "_state" (%n level)))] (` [(~ g!_behavior') (~ g!_state') (~ g!bottom)]))) bottom - (list;enumerate ancestors))) + (list.enumerate ancestors))) ## Names (do-template [<name> <category>] @@ -236,16 +236,16 @@ (let [[module kind] (ident-for <category>)] (format "{" kind "@" module "}" raw)))] - [signatureN #;;Signature] - [stateN #;;State] - [structN #;;Struct] + [signatureN #..Signature] + [stateN #..State] + [structN #..Struct] ) (def: (getterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs;Export) Text (List Code) Code Code (List Ident) + (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident) Code) - (let [g!get (code;local-symbol (getN interface)) - g!interface (code;local-symbol interface) + (let [g!get (code.local-symbol (getN interface)) + g!interface (code.local-symbol interface) g!_object (' _object) g!_behavior (' _behavior) g!_state (' _state) @@ -254,17 +254,17 @@ g!object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child))) g!tear-down (nest g!ancestors (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]))] - (` (def: (~@ (csw;export export)) ((~ g!get) (~ g!_object)) + (` (def: (~@ (csw.export export)) ((~ g!get) (~ g!_object)) (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)] (-> (~ g!object) (~ g!child))) (let [(~ g!tear-down) (~ g!_object)] (~ g!_state)))))) (def: (setterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs;Export) Text (List Code) Code Code (List Ident) + (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident) Code) - (let [g!set (code;local-symbol (setN interface)) - g!interface (code;local-symbol interface) + (let [g!set (code.local-symbol (setN interface)) + g!interface (code.local-symbol interface) g!_object (' _object) g!_behavior (' _behavior) g!_state (' _state) @@ -276,7 +276,7 @@ (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])) g!build-up (nest g!ancestors (` [(~ g!_behavior) (~ g!_input) (~ g!_extension)]))] - (` (def: (~@ (csw;export export)) + (` (def: (~@ (csw.export export)) ((~ g!set) (~ g!_input) (~ g!_object)) (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)] (-> (~ g!child) (~ g!object) (~ g!object))) @@ -284,10 +284,10 @@ (~ g!build-up)))))) (def: (updaterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs;Export) Text (List Code) Code Code (List Ident) + (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident) Code) - (let [g!update (code;local-symbol (updateN interface)) - g!interface (code;local-symbol interface) + (let [g!update (code.local-symbol (updateN interface)) + g!interface (code.local-symbol interface) g!_object (' _object) g!_behavior (' _behavior) g!_state (' _state) @@ -299,7 +299,7 @@ (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])) g!build-up (nest g!ancestors (` [(~ g!_behavior) ((~ g!_change) (~ g!_state)) (~ g!_extension)]))] - (` (def: (~@ (csw;export export)) + (` (def: (~@ (csw.export export)) ((~ g!update) (~ g!_change) (~ g!_object)) (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)] (-> (-> (~ g!child) (~ g!child)) @@ -311,75 +311,75 @@ (def: (type-to-code type) (-> Type (Meta Code)) (case type - (#;Primitive name params) + (#.Primitive name params) (do Monad<Meta> - [paramsC+ (M;map @ type-to-code params)] - (wrap (` (;primitive (~ (code;symbol ["" name])) + [paramsC+ (M.map @ type-to-code params)] + (wrap (` (.primitive (~ (code.symbol ["" name])) (~@ paramsC+))))) - #;Void - (Macro/wrap (` (;|))) + #.Void + (Macro/wrap (` (.|))) - #;Unit - (Macro/wrap (` (;&))) + #.Unit + (Macro/wrap (` (.&))) (^template [<tag> <macro> <flatten>] (<tag> _) (do Monad<Meta> - [partsC+ (M;map @ type-to-code (<flatten> type))] + [partsC+ (M.map @ type-to-code (<flatten> type))] (wrap (` (<macro> (~@ partsC+)))))) - ([#;Sum ;| type;flatten-variant] - [#;Product ;& type;flatten-tuple]) + ([#.Sum .| type.flatten-variant] + [#.Product .& type.flatten-tuple]) - (#;Function input output) + (#.Function input output) (do Monad<Meta> - [#let [[insT+ outT] (type;flatten-function type)] - insC+ (M;map @ type-to-code insT+) + [#let [[insT+ outT] (type.flatten-function type)] + insC+ (M.map @ type-to-code insT+) outC (type-to-code outT)] - (wrap (` (;-> (~@ insC+) (~ outC))))) + (wrap (` (.-> (~@ insC+) (~ outC))))) (^template [<tag>] (<tag> idx) - (Macro/wrap (` (<tag> (~ (code;nat idx)))))) - ([#;Bound] - [#;Var] - [#;Ex]) + (Macro/wrap (` (<tag> (~ (code.nat idx)))))) + ([#.Bound] + [#.Var] + [#.Ex]) - (#;Apply param fun) + (#.Apply param fun) (do Monad<Meta> - [#let [[funcT argsT+] (type;flatten-application type)] + [#let [[funcT argsT+] (type.flatten-application type)] funcC (type-to-code funcT) - argsC+ (M;map @ type-to-code argsT+)] + argsC+ (M.map @ type-to-code argsT+)] (wrap (` ((~ funcC) (~@ argsC+))))) - (#;Named name unnamedT) - (Macro/wrap (code;symbol name)) + (#.Named name unnamedT) + (Macro/wrap (code.symbol name)) _ - (macro;fail (format "Cannot convert type to code: " (type;to-text type))))) + (macro.fail (format "Cannot convert type to code: " (type.to-text type))))) -(syntax: #export (interface: [export csr;export] +(syntax: #export (interface: [export csr.export] [(^@ decl [interface parameters]) declarationS] - [?extends (p;maybe extension)] + [?extends (p.maybe extension)] [alias aliasS] - [annotations (p;default cs;empty-annotations csr;annotations)] - [methods (p;many (method (var-set parameters)))]) - (macro;with-gensyms [g!self-class g!child g!ext] + [annotations (p.default cs.empty-annotations csr.annotations)] + [methods (p.many (method (var-set parameters)))]) + (macro.with-gensyms [g!self-class g!child g!ext] (do @ - [module macro;current-module-name + [module macro.current-module-name [parent ancestors mappings] (: (Meta [Ident (List Ident) (List Code)]) (case ?extends - #;None + #.None (wrap [no-parent (list) (list)]) - (#;Some [super mappings]) + (#.Some [super mappings]) (do @ [[parent ancestors] (interfaceN super)] (wrap [parent (list& parent ancestors) mappings])))) - #let [g!signature (code;local-symbol (signatureN interface)) - g!interface (code;local-symbol interface) - g!parameters (L/map code;local-symbol parameters) - g!self-ref (if (list;empty? g!parameters) + #let [g!signature (code.local-symbol (signatureN interface)) + g!interface (code.local-symbol interface) + g!parameters (L/map code.local-symbol parameters) + g!self-ref (if (list.empty? g!parameters) (list g!interface) (list)) g!interface-def (if (no-parent? parent) @@ -388,7 +388,7 @@ [((~ g!signature) (~@ g!parameters) (~ g!recur)) (~ g!child) (~ g!ext)]))) - (let [g!parent (code;symbol parent) + (let [g!parent (code.symbol parent) g!ancestors (ancestor-inputs ancestors) g!recur (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)))] (` (Ex (~@ g!self-ref) [(~ g!ext) (~@ g!ancestors) (~ g!child)] @@ -397,18 +397,18 @@ (~ g!child) (~ g!ext)] (~@ g!ancestors))))))]] - (wrap (list& (` (sig: (~@ (csw;export export)) + (wrap (list& (` (sig: (~@ (csw.export export)) ((~ g!signature) (~@ g!parameters) (~ g!self-class)) - (~@ (let [de-alias (code;replace (code;local-symbol alias) g!self-class)] + (~@ (let [de-alias (code.replace (code.local-symbol alias) g!self-class)] (L/map (|>> (update@ #inputs (L/map de-alias)) (update@ #output de-alias) (declarationM g!self-class)) methods))))) - (` (type: (~@ (csw;export export)) ((~ g!interface) (~@ g!parameters)) + (` (type: (~@ (csw.export export)) ((~ g!interface) (~@ g!parameters)) (~ (|> annotations (with-interface parent [module interface]) - csw;annotations)) + csw.annotations)) (~ g!interface-def))) (getterN export interface g!parameters g!ext g!child ancestors) @@ -418,84 +418,84 @@ (let [g!ancestors (ancestor-inputs ancestors) g!states (L/compose g!ancestors (list g!child)) g!self-object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child))) - de-alias (code;replace (code;symbol ["" alias]) g!self-object)] + de-alias (code.replace (code.symbol ["" alias]) g!self-object)] (L/map (|>> (update@ #inputs (L/map de-alias)) (update@ #output de-alias) (definition export decl g!self-object g!ext g!states)) methods)))) ))) -(syntax: #export (class: [export csr;export] +(syntax: #export (class: [export csr.export] [[instance parameters] declarationS] - [annotations (p;default cs;empty-annotations csr;annotations)] + [annotations (p.default cs.empty-annotations csr.annotations)] [[interface interface-mappings] referenceS] - [super (p;maybe inheritance)] + [super (p.maybe inheritance)] state-type - [impls (p;many s;any)]) - (macro;with-gensyms [g!init g!extension] + [impls (p.many s.any)]) + (macro.with-gensyms [g!init g!extension] (do @ - [module macro;current-module-name + [module macro.current-module-name [interface _] (interfaceN interface) [parent ancestors parent-mappings] (: (Meta [Ident (List Ident) (List Code)]) (case super - (#;Some [super-class super-mappings]) + (#.Some [super-class super-mappings]) (do @ [[parent ancestors] (classN super-class)] (wrap [parent ancestors super-mappings])) - #;None + #.None (wrap [no-parent (list) (list)]))) g!inheritance (: (Meta (List Code)) (if (no-parent? parent) (wrap (list)) (do @ - [newT (macro;find-def-type (product;both id newN parent)) + [newT (macro.find-def-type (product.both id newN parent)) [depth rawT+] (extract newT) - codeT+ (M;map @ type-to-code rawT+)] + codeT+ (M.map @ type-to-code rawT+)] (wrap (L/map (specialize parent-mappings) codeT+))))) - #let [g!parameters (L/map code;local-symbol parameters) + #let [g!parameters (L/map code.local-symbol parameters) - g!state (code;local-symbol (stateN instance)) - g!struct (code;local-symbol (structN instance)) - g!class (code;local-symbol instance) + g!state (code.local-symbol (stateN instance)) + g!struct (code.local-symbol (structN instance)) + g!class (code.local-symbol instance) - g!signature (code;symbol (product;both id signatureN interface)) - g!interface (code;symbol interface) + g!signature (code.symbol (product.both id signatureN interface)) + g!interface (code.symbol interface) g!parent-structs (if (no-parent? parent) (list) - (L/map (|>> (product;both id structN) code;symbol) (list& parent ancestors)))] - g!parent-inits (M;map @ (function [_] (macro;gensym "parent-init")) + (L/map (|>> (product.both id structN) code.symbol) (list& parent ancestors)))] + g!parent-inits (M.map @ (function [_] (macro.gensym "parent-init")) g!parent-structs) #let [g!full-init (L/fold (function [[parent-struct parent-state] child] (` [(~ parent-struct) (~ parent-state) (~ child)])) (` [(~ g!struct) (~ g!init) []]) - (list;zip2 g!parent-structs g!parent-inits)) - g!new (code;local-symbol (newN instance)) + (list.zip2 g!parent-structs g!parent-inits)) + g!new (code.local-symbol (newN instance)) g!recur (` ((~ g!class) (~@ g!parameters) (~ g!extension))) - g!rec (if (list;empty? g!parameters) + g!rec (if (list.empty? g!parameters) (list (' #rec)) (list))]] - (wrap (list (` (type: (~@ (csw;export export)) + (wrap (list (` (type: (~@ (csw.export export)) ((~ g!state) (~@ g!parameters)) (~ state-type))) - (` (type: (~@ (csw;export export)) (~@ g!rec) ((~ g!class) (~@ g!parameters)) + (` (type: (~@ (csw.export export)) (~@ g!rec) ((~ g!class) (~@ g!parameters)) (~ (|> annotations (with-class interface parent [module instance]) - csw;annotations)) + csw.annotations)) (Ex [(~ g!extension)] (~ (if (no-parent? parent) (` ((~ g!interface) (~@ interface-mappings) (~ g!extension) ((~ g!state) (~@ g!parameters)))) - (let [g!parent (code;symbol parent)] + (let [g!parent (code.symbol parent)] (` ((~ g!parent) (~@ parent-mappings) [((~ g!signature) (~@ interface-mappings) (~ g!recur)) ((~ g!state) (~@ g!parameters)) (~ g!extension)])))))))) - (` (struct: (~@ (csw;export export)) (~ g!struct) + (` (struct: (~@ (csw.export export)) (~ g!struct) (All [(~@ g!parameters) (~ g!extension)] ((~ g!signature) (~@ interface-mappings) ((~ g!interface) (~@ interface-mappings) @@ -504,7 +504,7 @@ ((~ g!state) (~@ g!parameters))))) (~@ impls))) - (` (def: (~@ (csw;export export)) ((~ g!new) (~@ g!parent-inits) (~ g!init)) + (` (def: (~@ (csw.export export)) ((~ g!new) (~@ g!parent-inits) (~ g!init)) (All [(~@ g!parameters)] (-> (~@ g!inheritance) ((~ g!state) (~@ g!parameters)) diff --git a/stdlib/source/lux/type/opaque.lux b/stdlib/source/lux/type/opaque.lux index 8327a851a..62e284f64 100644 --- a/stdlib/source/lux/type/opaque.lux +++ b/stdlib/source/lux/type/opaque.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [applicative] [monad #+ do Monad] @@ -17,56 +17,56 @@ (All [a] (-> Text (List [Text a]) (Maybe a))) (case plist - #;Nil - #;None + #.Nil + #.None - (#;Cons [k' v] plist') + (#.Cons [k' v] plist') (if (text/= k k') - (#;Some v) + (#.Some v) (get k plist')))) (def: (put k v plist) (All [a] (-> Text a (List [Text a]) (List [Text a]))) (case plist - #;Nil + #.Nil (list [k v]) - (#;Cons [k' v'] plist') + (#.Cons [k' v'] plist') (if (text/= k k') - (#;Cons [k' v] plist') - (#;Cons [k' v'] (put k v plist'))))) + (#.Cons [k' v] plist') + (#.Cons [k' v'] (put k v plist'))))) (def: (remove k plist) (All [a] (-> Text (List [Text a]) (List [Text a]))) (case plist - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons [k' v'] plist') + (#.Cons [k' v'] plist') (if (text/= k k') plist' - (#;Cons [k' v'] (remove k plist'))))) + (#.Cons [k' v'] (remove k plist'))))) (def: down-cast Text "@opaque") (def: up-cast Text "@repr") -(def: macro-anns Code (' {#;macro? true})) +(def: macro-anns Code (' {#.macro? true})) (def: representation-name (-> Text Text) (|>> ($_ text/compose "{" kind "@" module "}") - (let [[module kind] (ident-for #;;Representation)]))) + (let [[module kind] (ident-for #..Representation)]))) (def: (install-casts' this-module-name name type-vars) (-> Text Text (List Text) (Meta Unit)) - (do macro;Monad<Meta> - [this-module (macro;find-module this-module-name) - #let [type-varsC (list/map code;local-symbol type-vars) - opaque-declaration (` ((~ (code;local-symbol name)) (~@ type-varsC))) - representation-declaration (` ((~ (code;local-symbol (representation-name name))) (~@ type-varsC))) + (do macro.Monad<Meta> + [this-module (macro.find-module this-module-name) + #let [type-varsC (list/map code.local-symbol type-vars) + opaque-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) + representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~@ type-varsC))) this-module (|> this-module - (update@ #;defs (put down-cast (: Def + (update@ #.defs (put down-cast (: Def [Macro macro-anns (: Macro (function [tokens] @@ -78,8 +78,8 @@ (~ value))))) _ - (macro;fail ($_ text/compose "Wrong syntax for " down-cast)))))]))) - (update@ #;defs (put up-cast (: Def + (macro.fail ($_ text/compose "Wrong syntax for " down-cast)))))]))) + (update@ #.defs (put up-cast (: Def [Macro macro-anns (: Macro (function [tokens] @@ -91,76 +91,76 @@ (~ value))))) _ - (macro;fail ($_ text/compose "Wrong syntax for " up-cast)))))]))))]] + (macro.fail ($_ text/compose "Wrong syntax for " up-cast)))))]))))]] (function [compiler] - (#E;Success [(update@ #;modules (put this-module-name this-module) compiler) + (#E.Success [(update@ #.modules (put this-module-name this-module) compiler) []])))) (def: (un-install-casts' this-module-name) (-> Text (Meta Unit)) - (do macro;Monad<Meta> - [this-module (macro;find-module this-module-name) + (do macro.Monad<Meta> + [this-module (macro.find-module this-module-name) #let [this-module (|> this-module - (update@ #;defs (remove down-cast)) - (update@ #;defs (remove up-cast)))]] + (update@ #.defs (remove down-cast)) + (update@ #.defs (remove up-cast)))]] (function [compiler] - (#E;Success [(update@ #;modules (put this-module-name this-module) compiler) + (#E.Success [(update@ #.modules (put this-module-name this-module) compiler) []])))) -(syntax: #hidden (install-casts [name s;local-symbol] - [type-vars (s;tuple (p;some s;local-symbol))]) +(syntax: #hidden (install-casts [name s.local-symbol] + [type-vars (s.tuple (p.some s.local-symbol))]) (do @ - [this-module-name macro;current-module-name - ?down-cast (macro;find-macro [this-module-name down-cast]) - ?up-cast (macro;find-macro [this-module-name up-cast])] + [this-module-name macro.current-module-name + ?down-cast (macro.find-macro [this-module-name down-cast]) + ?up-cast (macro.find-macro [this-module-name up-cast])] (case [?down-cast ?up-cast] - [#;None #;None] + [#.None #.None] (do @ [_ (install-casts' this-module-name name type-vars)] (wrap (list))) _ - (macro;fail ($_ text/compose + (macro.fail ($_ text/compose "Cannot temporarily define casting functions (" down-cast " & " up-cast ") because definitions like that already exist."))))) (syntax: #hidden (un-install-casts) - (do macro;Monad<Meta> - [this-module-name macro;current-module-name - ?down-cast (macro;find-macro [this-module-name down-cast]) - ?up-cast (macro;find-macro [this-module-name up-cast])] + (do macro.Monad<Meta> + [this-module-name macro.current-module-name + ?down-cast (macro.find-macro [this-module-name down-cast]) + ?up-cast (macro.find-macro [this-module-name up-cast])] (case [?down-cast ?up-cast] - [(#;Some _) (#;Some _)] + [(#.Some _) (#.Some _)] (do @ [_ (un-install-casts' this-module-name)] (wrap (list))) _ - (macro;fail ($_ text/compose + (macro.fail ($_ text/compose "Cannot un-define casting functions (" down-cast " & " up-cast ") because they do not exist."))))) (def: declaration - (s;Syntax [Text (List Text)]) - (p;either (s;form (p;seq s;local-symbol (p;some s;local-symbol))) - (p;seq s;local-symbol (:: p;Monad<Parser> wrap (list))))) + (s.Syntax [Text (List Text)]) + (p.either (s.form (p.seq s.local-symbol (p.some s.local-symbol))) + (p.seq s.local-symbol (:: p.Monad<Parser> wrap (list))))) -(syntax: #export (opaque: [export csr;export] +(syntax: #export (opaque: [export csr.export] [[name type-vars] declaration] - [annotations (p;default cs;empty-annotations csr;annotations)] + [annotations (p.default cs.empty-annotations csr.annotations)] representation-type - [primitives (p;some s;any)]) + [primitives (p.some s.any)]) (let [hidden-name (representation-name name) - type-varsC (list/map code;local-symbol type-vars) - opaque-declaration (` ((~ (code;local-symbol name)) (~@ type-varsC))) - representation-declaration (` ((~ (code;local-symbol hidden-name)) (~@ type-varsC)))] - (wrap (list& (` (type: (~@ (csw;export export)) (~ opaque-declaration) - (~ (csw;annotations annotations)) - (primitive (~ (code;text hidden-name)) [(~@ type-varsC)]))) - (` (type: (~@ (csw;export export)) (~ representation-declaration) + type-varsC (list/map code.local-symbol type-vars) + opaque-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) + representation-declaration (` ((~ (code.local-symbol hidden-name)) (~@ type-varsC)))] + (wrap (list& (` (type: (~@ (csw.export export)) (~ opaque-declaration) + (~ (csw.annotations annotations)) + (primitive (~ (code.text hidden-name)) [(~@ type-varsC)]))) + (` (type: (~@ (csw.export export)) (~ representation-declaration) (~ representation-type))) - (` (install-casts (~ (code;local-symbol name)) [(~@ type-varsC)])) + (` (install-casts (~ (code.local-symbol name)) [(~@ type-varsC)])) (list/compose primitives (list (` (un-install-casts)))))))) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index c124afdaa..262ccf9e4 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] ["p" parser "p/" Monad<Parser>] @@ -22,7 +22,7 @@ scale) (: (All [u] (-> (Qty (s u)) (Qty u))) de-scale) - (: r;Ratio + (: r.Ratio ratio)) (type: #export Pure @@ -61,54 +61,54 @@ (|>> (format "{" kind "@" module "}") (let [[module kind] (ident-for <tag>)])))] - [unit-name #;;Unit] - [scale-name #;;Scale] + [unit-name #..Unit] + [scale-name #..Scale] ) -(syntax: #export (unit: [export csr;export] - [name s;local-symbol] - [annotations (p;default cs;empty-annotations csr;annotations)]) - (wrap (list (` (type: (~@ (csw;export export)) (~ (code;local-symbol name)) - (~ (csw;annotations annotations)) - (primitive (~ (code;text (unit-name name)))))) - (` (def: (~@ (csw;export export)) (~ (code;local-symbol (format "@" name))) - (~ (code;local-symbol name)) +(syntax: #export (unit: [export csr.export] + [name s.local-symbol] + [annotations (p.default cs.empty-annotations csr.annotations)]) + (wrap (list (` (type: (~@ (csw.export export)) (~ (code.local-symbol name)) + (~ (csw.annotations annotations)) + (primitive (~ (code.text (unit-name name)))))) + (` (def: (~@ (csw.export export)) (~ (code.local-symbol (format "@" name))) + (~ (code.local-symbol name)) (:!! []))) ))) (def: ratio^ - (s;Syntax r;Ratio) - (s;tuple (do p;Monad<Parser> - [numerator s;int - _ (p;assert (format "Numerator must be positive: " (%i numerator)) + (s.Syntax r.Ratio) + (s.tuple (do p.Monad<Parser> + [numerator s.int + _ (p.assert (format "Numerator must be positive: " (%i numerator)) (i/> 0 numerator)) - denominator s;int - _ (p;assert (format "Denominator must be positive: " (%i denominator)) + denominator s.int + _ (p.assert (format "Denominator must be positive: " (%i denominator)) (i/> 0 denominator))] (wrap [(int-to-nat numerator) (int-to-nat denominator)])))) -(syntax: #export (scale: [export csr;export] - [name s;local-symbol] - [(^slots [#r;numerator #r;denominator]) ratio^] - [annotations (p;default cs;empty-annotations csr;annotations)]) - (let [g!scale (code;local-symbol name)] - (wrap (list (` (type: (~@ (csw;export export)) ((~ g!scale) (~' u)) - (~ (csw;annotations annotations)) - (primitive (~ (code;text (scale-name name))) [(~' u)]))) - (` (struct: (~@ (csw;export export)) (~ (code;local-symbol (format "@" name))) - (;;Scale (~ g!scale)) +(syntax: #export (scale: [export csr.export] + [name s.local-symbol] + [(^slots [#r.numerator #r.denominator]) ratio^] + [annotations (p.default cs.empty-annotations csr.annotations)]) + (let [g!scale (code.local-symbol name)] + (wrap (list (` (type: (~@ (csw.export export)) ((~ g!scale) (~' u)) + (~ (csw.annotations annotations)) + (primitive (~ (code.text (scale-name name))) [(~' u)]))) + (` (struct: (~@ (csw.export export)) (~ (code.local-symbol (format "@" name))) + (..Scale (~ g!scale)) (def: (~' scale) - (|>> ;;out - (i/* (~ (code;int (nat-to-int numerator)))) - (i// (~ (code;int (nat-to-int denominator)))) - (;;in (:! ((~ g!scale) ($ +0)) [])))) + (|>> ..out + (i/* (~ (code.int (nat-to-int numerator)))) + (i// (~ (code.int (nat-to-int denominator)))) + (..in (:! ((~ g!scale) ($ +0)) [])))) (def: (~' de-scale) - (|>> ;;out - (i/* (~ (code;int (nat-to-int denominator)))) - (i// (~ (code;int (nat-to-int numerator)))) - (;;in (:! ($ +0) [])))) + (|>> ..out + (i/* (~ (code.int (nat-to-int denominator)))) + (i// (~ (code.int (nat-to-int numerator)))) + (..in (:! ($ +0) [])))) (def: (~' ratio) - [(~ (code;nat numerator)) (~ (code;nat denominator))]))) + [(~ (code.nat numerator)) (~ (code.nat denominator))]))) )))) (do-template [<name> <op>] @@ -137,7 +137,7 @@ (def: #export (re-scale from to quantity) (All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u)))) - (let [[numerator denominator] (|> (:: to ratio) (r;r// (:: from ratio)))] + (let [[numerator denominator] (|> (:: to ratio) (r.r// (:: from ratio)))] (|> quantity out (i/* (nat-to-int numerator)) (i// (nat-to-int denominator)) diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index bb764dcb3..e4b130546 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["ex" exception #+ exception:] @@ -12,127 +12,127 @@ (exception: #export Index-Out-Of-Bounds) (exception: #export Inverted-Range) -(type: #export Blob (host;type (Array byte))) +(type: #export Blob (host.type (Array byte))) -(host;import java/util/Arrays +(host.import java/util/Arrays (#static copyOfRange [(Array byte) int int] (Array byte)) (#static equals [(Array byte) (Array byte)] boolean)) (def: byte-mask Nat - (|> +1 (bit;shift-left +8) n/dec)) + (|> +1 (bit.shift-left +8) n/dec)) (def: byte-to-nat (-> (primitive "java.lang.Byte") Nat) - (|>> host;b2l (:! Nat) (bit;and byte-mask))) + (|>> host.b2l (:! Nat) (bit.and byte-mask))) (def: #export (create size) (-> Nat Blob) - (host;array byte size)) + (host.array byte size)) (def: #export (read-8 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) idx) - (|> (host;array-read idx blob) byte-to-nat #e;Success) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) idx) + (|> (host.array-read idx blob) byte-to-nat #e.Success) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-16 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) (n/+ +1 idx)) - (#e;Success ($_ bit;or - (bit;shift-left +8 (byte-to-nat (host;array-read idx blob))) - (byte-to-nat (host;array-read (n/+ +1 idx) blob)))) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) (n/+ +1 idx)) + (#e.Success ($_ bit.or + (bit.shift-left +8 (byte-to-nat (host.array-read idx blob))) + (byte-to-nat (host.array-read (n/+ +1 idx) blob)))) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-32 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) (n/+ +3 idx)) - (#e;Success ($_ bit;or - (bit;shift-left +24 (byte-to-nat (host;array-read idx blob))) - (bit;shift-left +16 (byte-to-nat (host;array-read (n/+ +1 idx) blob))) - (bit;shift-left +8 (byte-to-nat (host;array-read (n/+ +2 idx) blob))) - (byte-to-nat (host;array-read (n/+ +3 idx) blob)))) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) (n/+ +3 idx)) + (#e.Success ($_ bit.or + (bit.shift-left +24 (byte-to-nat (host.array-read idx blob))) + (bit.shift-left +16 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) + (bit.shift-left +8 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) + (byte-to-nat (host.array-read (n/+ +3 idx) blob)))) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-64 idx blob) - (-> Nat Blob (e;Error Nat)) - (if (n/< (host;array-length blob) (n/+ +7 idx)) - (#e;Success ($_ bit;or - (bit;shift-left +56 (byte-to-nat (host;array-read idx blob))) - (bit;shift-left +48 (byte-to-nat (host;array-read (n/+ +1 idx) blob))) - (bit;shift-left +40 (byte-to-nat (host;array-read (n/+ +2 idx) blob))) - (bit;shift-left +32 (byte-to-nat (host;array-read (n/+ +3 idx) blob))) - (bit;shift-left +24 (byte-to-nat (host;array-read (n/+ +4 idx) blob))) - (bit;shift-left +16 (byte-to-nat (host;array-read (n/+ +5 idx) blob))) - (bit;shift-left +8 (byte-to-nat (host;array-read (n/+ +6 idx) blob))) - (byte-to-nat (host;array-read (n/+ +7 idx) blob)))) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (-> Nat Blob (e.Error Nat)) + (if (n/< (host.array-length blob) (n/+ +7 idx)) + (#e.Success ($_ bit.or + (bit.shift-left +56 (byte-to-nat (host.array-read idx blob))) + (bit.shift-left +48 (byte-to-nat (host.array-read (n/+ +1 idx) blob))) + (bit.shift-left +40 (byte-to-nat (host.array-read (n/+ +2 idx) blob))) + (bit.shift-left +32 (byte-to-nat (host.array-read (n/+ +3 idx) blob))) + (bit.shift-left +24 (byte-to-nat (host.array-read (n/+ +4 idx) blob))) + (bit.shift-left +16 (byte-to-nat (host.array-read (n/+ +5 idx) blob))) + (bit.shift-left +8 (byte-to-nat (host.array-read (n/+ +6 idx) blob))) + (byte-to-nat (host.array-read (n/+ +7 idx) blob)))) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-8 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) idx) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) idx) (exec (|> blob - (host;array-write idx (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-16 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) (n/+ +1 idx)) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) (n/+ +1 idx)) (exec (|> blob - (host;array-write idx (host;l2b (:! Int (bit;shift-right +8 value)))) - (host;array-write (n/+ +1 idx) (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int (bit.shift-right +8 value)))) + (host.array-write (n/+ +1 idx) (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-32 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) (n/+ +3 idx)) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) (n/+ +3 idx)) (exec (|> blob - (host;array-write idx (host;l2b (:! Int (bit;shift-right +24 value)))) - (host;array-write (n/+ +1 idx) (host;l2b (:! Int (bit;shift-right +16 value)))) - (host;array-write (n/+ +2 idx) (host;l2b (:! Int (bit;shift-right +8 value)))) - (host;array-write (n/+ +3 idx) (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int (bit.shift-right +24 value)))) + (host.array-write (n/+ +1 idx) (host.l2b (:! Int (bit.shift-right +16 value)))) + (host.array-write (n/+ +2 idx) (host.l2b (:! Int (bit.shift-right +8 value)))) + (host.array-write (n/+ +3 idx) (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-64 idx value blob) - (-> Nat Nat Blob (e;Error Unit)) - (if (n/< (host;array-length blob) (n/+ +7 idx)) + (-> Nat Nat Blob (e.Error Unit)) + (if (n/< (host.array-length blob) (n/+ +7 idx)) (exec (|> blob - (host;array-write idx (host;l2b (:! Int (bit;shift-right +56 value)))) - (host;array-write (n/+ +1 idx) (host;l2b (:! Int (bit;shift-right +48 value)))) - (host;array-write (n/+ +2 idx) (host;l2b (:! Int (bit;shift-right +40 value)))) - (host;array-write (n/+ +3 idx) (host;l2b (:! Int (bit;shift-right +32 value)))) - (host;array-write (n/+ +4 idx) (host;l2b (:! Int (bit;shift-right +24 value)))) - (host;array-write (n/+ +5 idx) (host;l2b (:! Int (bit;shift-right +16 value)))) - (host;array-write (n/+ +6 idx) (host;l2b (:! Int (bit;shift-right +8 value)))) - (host;array-write (n/+ +7 idx) (host;l2b (:! Int value)))) - (#e;Success [])) - (ex;throw Index-Out-Of-Bounds (%n idx)))) + (host.array-write idx (host.l2b (:! Int (bit.shift-right +56 value)))) + (host.array-write (n/+ +1 idx) (host.l2b (:! Int (bit.shift-right +48 value)))) + (host.array-write (n/+ +2 idx) (host.l2b (:! Int (bit.shift-right +40 value)))) + (host.array-write (n/+ +3 idx) (host.l2b (:! Int (bit.shift-right +32 value)))) + (host.array-write (n/+ +4 idx) (host.l2b (:! Int (bit.shift-right +24 value)))) + (host.array-write (n/+ +5 idx) (host.l2b (:! Int (bit.shift-right +16 value)))) + (host.array-write (n/+ +6 idx) (host.l2b (:! Int (bit.shift-right +8 value)))) + (host.array-write (n/+ +7 idx) (host.l2b (:! Int value)))) + (#e.Success [])) + (ex.throw Index-Out-Of-Bounds (%n idx)))) (def: #export (size blob) (-> Blob Nat) - (host;array-length blob)) + (host.array-length blob)) (def: #export (slice from to blob) - (-> Nat Nat Blob (e;Error Blob)) + (-> Nat Nat Blob (e.Error Blob)) (with-expansions [<description> (as-is (format "from = " (%n from) " | " "to = " (%n to)))] - (let [size (host;array-length blob)] + (let [size (host.array-length blob)] (cond (not (n/<= to from)) - (ex;throw Inverted-Range <description>) + (ex.throw Inverted-Range <description>) (not (and (n/< size from) (n/< size to))) - (ex;throw Index-Out-Of-Bounds <description>) + (ex.throw Index-Out-Of-Bounds <description>) ## else - (#e;Success (Arrays::copyOfRange [blob (:! Int from) (:! Int (n/inc to))])))))) + (#e.Success (Arrays::copyOfRange [blob (:! Int from) (:! Int (n/inc to))])))))) (def: #export (slice' from blob) - (-> Nat Blob (e;Error Blob)) - (slice from (n/dec (host;array-length blob)) blob)) + (-> Nat Blob (e.Error Blob)) + (slice from (n/dec (host.array-length blob)) blob)) -(struct: #export _ (eq;Eq Blob) +(struct: #export _ (eq.Eq Blob) (def: (= reference sample) (Arrays::equals [reference sample]))) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 62beffb39..f84e51d03 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -1,4 +1,4 @@ -(;module: +(.module: [lux #- open] (lux (control [monad #+ do]) (data ["e" error] @@ -16,25 +16,25 @@ (close [] (Task Unit))) (for {"JVM" - (as-is (host;import java/lang/AutoCloseable + (as-is (host.import java/lang/AutoCloseable (close [] #io #try void)) - (host;import java/io/InputStream) + (host.import java/io/InputStream) - (host;import java/io/Reader) + (host.import java/io/Reader) - (host;import java/io/InputStreamReader + (host.import java/io/InputStreamReader (new [InputStream])) - (host;import java/io/BufferedReader + (host.import java/io/BufferedReader (new [Reader]) (read [] #io #try int) (readLine [] #io #try String)) - (host;import java/io/PrintStream + (host.import java/io/PrintStream (print [String] #io #try void)) - (host;import java/lang/System + (host.import java/lang/System (#static in java/io/InputStream) (#static out java/io/PrintStream)) @@ -46,29 +46,29 @@ (|>> get@Console (get@ #input) (BufferedReader::read []) - (:: io;Functor<Process> map (|>> int-to-nat text;from-code)) - promise;future)) + (:: io.Functor<Process> map (|>> int-to-nat text.from-code)) + promise.future)) (def: read-line (|>> get@Console (get@ #input) (BufferedReader::readLine []) - promise;future)) + promise.future)) (def: (write message) (|>> get@Console (get@ #output) (PrintStream::print [message]) - promise;future)) + promise.future)) (def: (close self) - (promise;future - (do io;Monad<Process> + (promise.future + (do io.Monad<Process> [_ (AutoCloseable::close [] (|> self get@Console (get@ #input)))] (AutoCloseable::close [] (|> self get@Console (get@ #output))))))) (def: #export open (Process Console) - (io (#e;Success (new@JVM-Console {#input (|> System::in InputStreamReader::new BufferedReader::new) + (io (#e.Success (new@JVM-Console {#input (|> System::in InputStreamReader::new BufferedReader::new) #output System::out}))))) }) diff --git a/stdlib/source/lux/world/env.jvm.lux b/stdlib/source/lux/world/env.jvm.lux index 828f6b5da..ee20b9b1c 100644 --- a/stdlib/source/lux/world/env.jvm.lux +++ b/stdlib/source/lux/world/env.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [text] (format [context #+ Context]) @@ -6,31 +6,31 @@ [io #- run] [host])) -(host;import java/lang/String) +(host.import java/lang/String) -(host;import (java/util/Map$Entry k v) +(host.import (java/util/Map$Entry k v) (getKey [] k) (getValue [] v)) -(host;import (java/util/Iterator a) +(host.import (java/util/Iterator a) (hasNext [] boolean) (next [] a)) -(host;import (java/util/Set a) +(host.import (java/util/Set a) (iterator [] (Iterator a))) -(host;import (java/util/Map k v) +(host.import (java/util/Map k v) (entrySet [] (Set (Map$Entry k v)))) -(host;import java/lang/System +(host.import java/lang/System (#static getenv [] (java/util/Map String String))) (def: (consume-iterator f iterator) (All [a b] (-> (-> a b) (Iterator a) (List b))) (if (Iterator::hasNext [] iterator) - (#;Cons (f (Iterator::next [] iterator)) + (#.Cons (f (Iterator::next [] iterator)) (consume-iterator f iterator)) - #;Nil)) + #.Nil)) (def: (entry-to-kv entry) (All [k v] (-> (Map$Entry k v) [k v])) @@ -43,4 +43,4 @@ (Map::entrySet []) (Set::iterator []) (consume-iterator entry-to-kv) - (dict;from-list text;Hash<Text>)))) + (dict.from-list text.Hash<Text>)))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 0b85068ef..5fa4e1661 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["ex" exception #+ exception:]) @@ -16,7 +16,7 @@ (type: #export File Text) -(host;import #long java/io/File +(host.import #long java/io/File (new [String]) (exists [] #io #try boolean) (mkdir [] #io #try boolean) @@ -33,26 +33,26 @@ (canWrite [] #io #try boolean) (canExecute [] #io #try boolean)) -(host;import java/lang/AutoCloseable +(host.import java/lang/AutoCloseable (close [] #io #try void)) -(host;import java/io/OutputStream +(host.import java/io/OutputStream (write [(Array byte)] #io #try void) (flush [] #io #try void)) -(host;import java/io/FileOutputStream +(host.import java/io/FileOutputStream (new [java/io/File boolean] #io #try)) -(host;import java/io/InputStream +(host.import java/io/InputStream (read [(Array byte)] #io #try int)) -(host;import java/io/FileInputStream +(host.import java/io/FileInputStream (new [java/io/File] #io #try)) (do-template [<name> <flag>] [(def: #export (<name> data file) - (-> Blob File (T;Task Unit)) - (P;future (do (E;ErrorT io;Monad<IO>) + (-> Blob File (T.Task Unit)) + (P.future (do (E.ErrorT io.Monad<IO>) [stream (FileOutputStream::new [(java/io/File::new file) <flag>]) _ (OutputStream::write [data] stream) _ (OutputStream::flush [] stream)] @@ -63,35 +63,35 @@ ) (def: #export (read file) - (-> File (T;Task Blob)) - (P;future (do (E;ErrorT io;Monad<IO>) + (-> File (T.Task Blob)) + (P.future (do (E.ErrorT io.Monad<IO>) [#let [file' (java/io/File::new file)] size (java/io/File::length [] file') - #let [data (blob;create (int-to-nat size))] + #let [data (blob.create (int-to-nat size))] stream (FileInputStream::new [file']) bytes-read (InputStream::read [data] stream) _ (AutoCloseable::close [] stream)] (if (i/= size bytes-read) (wrap data) - (io;io (ex;throw Could-Not-Read-All-Data file)))))) + (io.io (ex.throw Could-Not-Read-All-Data file)))))) (def: #export (size file) - (-> File (T;Task Nat)) - (P;future (do (E;ErrorT io;Monad<IO>) + (-> File (T.Task Nat)) + (P.future (do (E.ErrorT io.Monad<IO>) [size (java/io/File::length [] (java/io/File::new file))] (wrap (int-to-nat size))))) (def: #export (files dir) - (-> File (T;Task (List File))) - (P;future (do (E;ErrorT io;Monad<IO>) + (-> File (T.Task (List File))) + (P.future (do (E.ErrorT io.Monad<IO>) [files (java/io/File::listFiles [] (java/io/File::new dir))] - (monad;map @ (java/io/File::getAbsolutePath []) - (array;to-list files))))) + (monad.map @ (java/io/File::getAbsolutePath []) + (array.to-list files))))) (do-template [<name> <method>] [(def: #export (<name> file) - (-> File (T;Task Bool)) - (P;future (<method> [] (java/io/File::new file))))] + (-> File (T.Task Bool)) + (P.future (<method> [] (java/io/File::new file))))] [exists? java/io/File::exists] [make-dir java/io/File::mkdir] @@ -104,17 +104,17 @@ ) (def: #export (move target source) - (-> File File (T;Task Bool)) - (P;future (java/io/File::renameTo [(java/io/File::new target)] + (-> File File (T.Task Bool)) + (P.future (java/io/File::renameTo [(java/io/File::new target)] (java/io/File::new source)))) (def: #export (get-last-modified file) - (-> File (T;Task i;Instant)) - (P;future (do (E;ErrorT io;Monad<IO>) + (-> File (T.Task i.Instant)) + (P.future (do (E.ErrorT io.Monad<IO>) [millis (java/io/File::lastModified [] (java/io/File::new file))] - (wrap (|> millis d;from-millis i;absolute))))) + (wrap (|> millis d.from-millis i.absolute))))) (def: #export (set-last-modified time file) - (-> i;Instant File (T;Task Bool)) - (P;future (java/io/File::setLastModified [(|> time i;relative d;to-millis)] + (-> i.Instant File (T.Task Bool)) + (P.future (java/io/File::setLastModified [(|> time i.relative d.to-millis)] (java/io/File::new file)))) diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux index c9e2829e5..c7e597a66 100644 --- a/stdlib/source/lux/world/net.lux +++ b/stdlib/source/lux/world/net.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux) (type: #export Address Text) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index f279a0873..3d71e85f8 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control monad) (concurrency ["P" promise] @@ -11,24 +11,24 @@ [host]) [//]) -(host;import java/lang/AutoCloseable +(host.import java/lang/AutoCloseable (close [] #io #try void)) -(host;import java/io/Flushable +(host.import java/io/Flushable (flush [] #io #try void)) -(host;import java/io/InputStream +(host.import java/io/InputStream (read [(Array byte) int int] #io #try int)) -(host;import java/io/OutputStream +(host.import java/io/OutputStream (write [(Array byte) int int] #io #try void)) -(host;import java/net/Socket +(host.import java/net/Socket (new [String int] #io #try) (getInputStream [] #io #try InputStream) (getOutputStream [] #io #try OutputStream)) -(host;import java/net/ServerSocket +(host.import java/net/ServerSocket (new [int] #io #try) (accept [] #io #try Socket)) @@ -43,31 +43,31 @@ (def: #export (read data offset length self) (let [in (get@ #in (@repr self))] - (P;future - (do (e;ErrorT io;Monad<IO>) + (P.future + (do (e.ErrorT io.Monad<IO>) [bytes-read (InputStream::read [data (nat-to-int offset) (nat-to-int length)] in)] (wrap (int-to-nat bytes-read)))))) (def: #export (write data offset length self) (let [out (get@ #out (@repr self))] - (P;future - (do (e;ErrorT io;Monad<IO>) + (P.future + (do (e.ErrorT io.Monad<IO>) [_ (OutputStream::write [data (nat-to-int offset) (nat-to-int length)] out)] (Flushable::flush [] out))))) (def: #export (close self) (let [(^open) (@repr self)] - (P;future - (do (e;ErrorT io;Monad<IO>) + (P.future + (do (e.ErrorT io.Monad<IO>) [_ (AutoCloseable::close [] in) _ (AutoCloseable::close [] out)] (AutoCloseable::close [] socket))))) (def: (tcp-client socket) - (-> Socket (io;IO (e;Error TCP))) - (do (e;ErrorT io;Monad<IO>) + (-> Socket (io.IO (e.Error TCP))) + (do (e.ErrorT io.Monad<IO>) [input (Socket::getInputStream [] socket) output (Socket::getOutputStream [] socket)] (wrap (@opaque {#socket socket @@ -75,55 +75,55 @@ #out output})))) (def: #export (client address port) - (-> //;Address //;Port (T;Task TCP)) - (P;future - (do (e;ErrorT io;Monad<IO>) + (-> //.Address //.Port (T.Task TCP)) + (P.future + (do (e.ErrorT io.Monad<IO>) [socket (Socket::new [address (nat-to-int port)])] (tcp-client socket)))) (def: (await-server-release client-channel server) - (-> (frp;Channel TCP) ServerSocket (P;Promise Unit)) - (do P;Monad<Promise> + (-> (frp.Channel TCP) ServerSocket (P.Promise Unit)) + (do P.Monad<Promise> [outcome client-channel] (case outcome ## Channel has been closed. ## Must close associated server. - #;None - (P;future - (do io;Monad<IO> + #.None + (P.future + (do io.Monad<IO> [_ (AutoCloseable::close [] server)] (wrap []))) ## A client was generated. ## Nothing to be done... - (#;Some _) + (#.Some _) (wrap [])))) (def: #export (server port) - (-> //;Port (T;Task (frp;Channel TCP))) - (P;future - (do (e;ErrorT io;Monad<IO>) + (-> //.Port (T.Task (frp.Channel TCP))) + (P.future + (do (e.ErrorT io.Monad<IO>) [server (ServerSocket::new [(nat-to-int port)]) - #let [output (frp;channel TCP) - _ (: (P;Promise Bool) - (P;future + #let [output (frp.channel TCP) + _ (: (P.Promise Bool) + (P.future (loop [tail output] - (do io;Monad<IO> - [?client (do (e;ErrorT io;Monad<IO>) + (do io.Monad<IO> + [?client (do (e.ErrorT io.Monad<IO>) [socket (ServerSocket::accept [] server)] (tcp-client socket))] (case ?client - (#e;Error error) - (frp;close tail) + (#e.Error error) + (frp.close tail) - (#e;Success client) + (#e.Success client) (do @ - [?tail' (frp;write client tail)] + [?tail' (frp.write client tail)] (case ?tail' - #;None + #.None (wrap true) - (#;Some tail') + (#.Some tail') (exec (await-server-release tail' server) (recur tail')))))))))]] (wrap output)))) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index 3bb94e112..4f58f1563 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control monad ["ex" exception #+ exception:]) @@ -14,24 +14,24 @@ [host]) [//]) -(host;import java/lang/AutoCloseable +(host.import java/lang/AutoCloseable (close [] #io #try void)) -(host;import java/io/Flushable +(host.import java/io/Flushable (flush [] #io #try void)) -(host;import java/net/InetAddress +(host.import java/net/InetAddress (#static getAllByName [String] #io #try (Array InetAddress)) (getHostAddress [] String)) -(host;import java/net/DatagramPacket +(host.import java/net/DatagramPacket (new #as new|send [(Array byte) int int InetAddress int]) (new #as new|receive [(Array byte) int int]) (getAddress [] InetAddress) (getPort [] int) (getLength [] int)) -(host;import java/net/DatagramSocket +(host.import java/net/DatagramSocket (new #as new|client [] #io #try) (new #as new|server [int] #io #try) (receive [DatagramPacket] #io #try void) @@ -45,24 +45,24 @@ (exception: #export Multiple-Candidate-Addresses) (def: (resolve address) - (-> //;Address (io;IO (e;Error InetAddress))) - (do (e;ErrorT io;Monad<IO>) + (-> //.Address (io.IO (e.Error InetAddress))) + (do (e.ErrorT io.Monad<IO>) [addresses (InetAddress::getAllByName [address])] - (: (io;IO (e;Error InetAddress)) - (case (array;size addresses) - +0 (io;io (ex;throw Cannot-Resolve-Address address)) - +1 (wrap (maybe;assume (array;read +0 addresses))) - _ (io;io (ex;throw Multiple-Candidate-Addresses address)))))) + (: (io.IO (e.Error InetAddress)) + (case (array.size addresses) + +0 (io.io (ex.throw Cannot-Resolve-Address address)) + +1 (wrap (maybe.assume (array.read +0 addresses))) + _ (io.io (ex.throw Multiple-Candidate-Addresses address)))))) (opaque: #export UDP {} {#socket DatagramSocket} (def: #export (read data offset length self) - (-> Blob Nat Nat UDP (T;Task [Nat //;Address //;Port])) + (-> Blob Nat Nat UDP (T.Task [Nat //.Address //.Port])) (let [(^open) (@repr self) packet (DatagramPacket::new|receive [data (nat-to-int offset) (nat-to-int length)])] - (P;future - (do (e;ErrorT io;Monad<IO>) + (P.future + (do (e.ErrorT io.Monad<IO>) [_ (DatagramSocket::receive [packet] socket) #let [bytes-read (int-to-nat (DatagramPacket::getLength [] packet))]] (wrap [bytes-read @@ -70,31 +70,31 @@ (int-to-nat (DatagramPacket::getPort [] packet))]))))) (def: #export (write address port data offset length self) - (-> //;Address //;Port Blob Nat Nat UDP (T;Task Unit)) - (P;future - (do (e;ErrorT io;Monad<IO>) + (-> //.Address //.Port Blob Nat Nat UDP (T.Task Unit)) + (P.future + (do (e.ErrorT io.Monad<IO>) [address (resolve address) #let [(^open) (@repr self)]] (DatagramSocket::send (DatagramPacket::new|send [data (nat-to-int offset) (nat-to-int length) address (nat-to-int port)]) socket)))) (def: #export (close self) - (-> UDP (T;Task Unit)) + (-> UDP (T.Task Unit)) (let [(^open) (@repr self)] - (P;future + (P.future (AutoCloseable::close [] socket)))) (def: #export (client _) - (-> Unit (T;Task UDP)) - (P;future - (do (e;ErrorT io;Monad<IO>) + (-> Unit (T.Task UDP)) + (P.future + (do (e.ErrorT io.Monad<IO>) [socket (DatagramSocket::new|client [])] (wrap (@opaque (#socket socket)))))) (def: #export (server port) - (-> //;Port (T;Task UDP)) - (P;future - (do (e;ErrorT io;Monad<IO>) + (-> //.Port (T.Task UDP)) + (P.future + (do (e.ErrorT io.Monad<IO>) [socket (DatagramSocket::new|server [(nat-to-int port)])] (wrap (@opaque (#socket socket)))))) ) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index cfc562686..8bd3a1ee5 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux lux/test (lux (control ["M" monad #+ do Monad]) @@ -14,9 +14,9 @@ (context: "Value identity." (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) - x (r;text size) - y (r;text size)] + [size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) + x (r.text size) + y (r.text size)] ($_ seq (test "Every value is identical to itself, and the 'id' function doesn't change values in any way." (and (is x x) @@ -52,8 +52,8 @@ (and (|> value inc even?) (|> value dec even?)))))))] - ["Nat" r;nat n/inc n/dec n/even? n/odd? n/= n/< n/>] - ["Int" r;int i/inc i/dec i/even? i/odd? i/= i/< i/>] + ["Nat" r.nat n/inc n/dec n/even? n/odd? n/= n/< n/>] + ["Int" r.int i/inc i/dec i/even? i/odd? i/= i/< i/>] ) (do-template [category rand-gen = < > <= >= min max] @@ -80,10 +80,10 @@ (>= y (max x y))) )))))] - ["Int" r;int i/= i/< i/> i/<= i/>= i/min i/max] - ["Nat" r;nat n/= n/< n/> n/<= n/>= n/min n/max] - ["Frac" r;frac f/= f/< f/> f/<= f/>= f/min f/max] - ["Deg" r;deg d/= d/< d/> d/<= d/>= d/min d/max] + ["Int" r.int i/= i/< i/> i/<= i/>= i/min i/max] + ["Nat" r.nat n/= n/< n/> n/<= n/>= n/min n/max] + ["Frac" r.frac f/= f/< f/> f/<= f/>= f/min f/max] + ["Deg" r.deg d/= d/< d/> d/<= d/>= d/min d/max] ) (do-template [category rand-gen = + - * / <%> > <0> <1> <factor> %x <cap> <prep>] @@ -124,7 +124,7 @@ [x (:: @ map <cap> rand-gen) y (|> rand-gen (:: @ map <cap>) - (r;filter (|>> (= <0>) not))) + (r.filter (|>> (= <0>) not))) #let [r (<%> y x) x' (- r x)]] (test "" @@ -136,10 +136,10 @@ (|> x' (/ y) (* y) (= x')))) ))))] - ["Nat" r;nat n/= n/+ n/- n/* n// n/% n/> +0 +1 +1000000 %n (n/% +1000) id] - ["Int" r;int i/= i/+ i/- i/* i// i/% i/> 0 1 1000000 %i (i/% 1000) id] - ["Frac" r;frac f/= f/+ f/- f/* f// f/% f/> 0.0 1.0 1000000.0 %r id math;floor] - ["Deg" r;deg d/= d/+ d/- d/* d// d/% d/> .0 ("lux deg max") ("lux deg max") %f id id] + ["Nat" r.nat n/= n/+ n/- n/* n// n/% n/> +0 +1 +1000000 %n (n/% +1000) id] + ["Int" r.int i/= i/+ i/- i/* i// i/% i/> 0 1 1000000 %i (i/% 1000) id] + ["Frac" r.frac f/= f/+ f/- f/* f// f/% f/> 0.0 1.0 1000000.0 %r id math.floor] + ["Deg" r.deg d/= d/+ d/- d/* d// d/% d/> .0 ("lux deg max") ("lux deg max") %f id id] ) (do-template [category rand-gen -> <- = <cap> %a %z] @@ -151,11 +151,11 @@ (test "" (|> value -> <- (= value))))))] - ["Int->Nat" r;int int-to-nat nat-to-int i/= (i/% 1000000) %i %n] - ["Nat->Int" r;nat nat-to-int int-to-nat n/= (n/% +1000000) %n %i] - ["Int->Frac" r;int int-to-frac frac-to-int i/= (i/% 1000000) %i %r] - ["Frac->Int" r;frac frac-to-int int-to-frac f/= math;floor %r %i] - ## [r;frac frac-to-deg deg-to-frac f/= (f/% 1.0) %r %f] + ["Int->Nat" r.int int-to-nat nat-to-int i/= (i/% 1000000) %i %n] + ["Nat->Int" r.nat nat-to-int int-to-nat n/= (n/% +1000000) %n %i] + ["Int->Frac" r.int int-to-frac frac-to-int i/= (i/% 1000000) %i %r] + ["Frac->Int" r.frac frac-to-int int-to-frac f/= math.floor %r %i] + ## [r.frac frac-to-deg deg-to-frac f/= (f/% 1.0) %r %f] ) (context: "Simple macros and constructs" @@ -170,25 +170,25 @@ (test "Can create lists easily through macros." (and (case (list 1 2 3) - (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) + (#.Cons 1 (#.Cons 2 (#.Cons 3 #.Nil))) true _ false) (case (list& 1 2 3 (list 4 5 6)) - (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil)))))) + (#.Cons 1 (#.Cons 2 (#.Cons 3 (#.Cons 4 (#.Cons 5 (#.Cons 6 #.Nil)))))) true _ false))) (test "Can have defaults for Maybe values." - (and (is "yolo" (maybe;default "yolo" - #;None)) + (and (is "yolo" (maybe.default "yolo" + #.None)) - (is "lol" (maybe;default "yolo" - (#;Some "lol"))))) + (is "lol" (maybe.default "yolo" + (#.Some "lol"))))) )) (template: (hypotenuse x y) @@ -197,8 +197,8 @@ (context: "Templates." (<| (times +100) (do @ - [x r;int - y r;int] + [x r.int + y r.int] (test "Template application is a stand-in for the templated code." (i/= (i/+ (i/* x x) (i/* y y)) (hypotenuse x y)))))) diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index 37e954e76..b5f251c57 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -18,43 +18,43 @@ (context: "CLI" (<| (times +100) (do @ - [num-args (|> r;nat (:: @ map (n/% +10))) - #let [(^open "Nat/") number;Codec<Text,Nat> - gen-arg (:: @ map Nat/encode r;nat)] + [num-args (|> r.nat (:: @ map (n/% +10))) + #let [(^open "Nat/") number.Codec<Text,Nat> + gen-arg (:: @ map Nat/encode r.nat)] yes gen-arg - #let [gen-ignore (|> (r;text +5) (r;filter (|>> (text/= yes) not)))] + #let [gen-ignore (|> (r.text +5) (r.filter (|>> (text/= yes) not)))] no gen-ignore - pre-ignore (r;list +5 gen-ignore) - post-ignore (r;list +5 gen-ignore)] + pre-ignore (r.list +5 gen-ignore) + post-ignore (r.list +5 gen-ignore)] ($_ seq (test "Can read any argument." - (|> (/;run (list yes) /;any) - (case> (#E;Error _) + (|> (/.run (list yes) /.any) + (case> (#E.Error _) false - (#E;Success arg) + (#E.Success arg) (text/= arg yes)))) (test "Can test tokens." - (and (|> (/;run (list yes) (/;this yes)) - (case> (#E;Error _) false (#E;Success _) true)) - (|> (/;run (list no) (/;this yes)) - (case> (#E;Error _) true (#E;Success _) false)))) + (and (|> (/.run (list yes) (/.this yes)) + (case> (#E.Error _) false (#E.Success _) true)) + (|> (/.run (list no) (/.this yes)) + (case> (#E.Error _) true (#E.Success _) false)))) (test "Can use custom token parsers." - (|> (/;run (list yes) (/;parse Nat/decode)) - (case> (#E;Error _) + (|> (/.run (list yes) (/.parse Nat/decode)) + (case> (#E.Error _) false - (#E;Success parsed) + (#E.Success parsed) (text/= (Nat/encode parsed) yes)))) (test "Can query if there are any more inputs." - (and (|> (/;run (list) /;end) - (case> (#E;Success []) true _ false)) - (|> (/;run (list yes) (p;not /;end)) - (case> (#E;Success []) false _ true)))) + (and (|> (/.run (list) /.end) + (case> (#E.Success []) true _ false)) + (|> (/.run (list yes) (p.not /.end)) + (case> (#E.Success []) false _ true)))) (test "Can parse CLI input anywhere." - (|> (/;run (list;concat (list pre-ignore (list yes) post-ignore)) - (|> (/;somewhere (/;this yes)) - (p;before (p;some /;any)))) - (case> (#E;Error _) false (#E;Success _) true))) + (|> (/.run (list.concat (list pre-ignore (list yes) post-ignore)) + (|> (/.somewhere (/.this yes)) + (p.before (p.some /.any)))) + (case> (#E.Error _) false (#E.Success _) true))) )))) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index 450f3b399..f041ebe54 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io #+ IO io] (control ["M" monad #+ do Monad] @@ -15,62 +15,62 @@ Nat ((handle message state self) - (do T;Monad<Task> + (do T.Monad<Task> [#let [_ (log! "BEFORE")] output (message state self) #let [_ (log! "AFTER")]] (wrap output))) ((stop cause state) - (P/wrap (log! (if (ex;match? &;Killed cause) + (P/wrap (log! (if (ex.match? &.Killed cause) (format "Counter was killed: " (%n state)) cause))))) (message: #export Counter (count! [increment Nat] state self Nat) (let [state' (n/+ increment state)] - (T;return [state' state']))) + (T.return [state' state']))) (context: "Actors" ($_ seq (test "Can check if an actor is alive." - (io;run (do io;Monad<IO> + (io.run (do io.Monad<IO> [counter (new@Counter +0)] - (wrap (&;alive? counter))))) + (wrap (&.alive? counter))))) (test "Can kill actors." - (io;run (do io;Monad<IO> + (io.run (do io.Monad<IO> [counter (new@Counter +0) - killed? (&;kill counter)] + killed? (&.kill counter)] (wrap (and killed? - (not (&;alive? counter))))))) + (not (&.alive? counter))))))) (test "Can poison actors." - (io;run (do io;Monad<IO> + (io.run (do io.Monad<IO> [counter (new@Counter +0) - poisoned? (&;poison counter)] + poisoned? (&.poison counter)] (wrap (and poisoned? - (not (&;alive? counter))))))) + (not (&.alive? counter))))))) (test "Cannot kill an already dead actor." - (io;run (do io;Monad<IO> + (io.run (do io.Monad<IO> [counter (new@Counter +0) - first-time (&;kill counter) - second-time (&;kill counter)] + first-time (&.kill counter) + second-time (&.kill counter)] (wrap (and first-time (not second-time)))))) (test "Cannot poison an already dead actor." - (io;run (do io;Monad<IO> + (io.run (do io.Monad<IO> [counter (new@Counter +0) - first-time (&;kill counter) - second-time (&;poison counter)] + first-time (&.kill counter) + second-time (&.poison counter)] (wrap (and first-time (not second-time)))))) - (wrap (do P;Monad<Promise> - [result (do T;Monad<Task> - [#let [counter (io;run (new@Counter +0))] + (wrap (do P.Monad<Promise> + [result (do T.Monad<Task> + [#let [counter (io.run (new@Counter +0))] output-1 (count! +1 counter) output-2 (count! +1 counter) output-3 (count! +1 counter)] @@ -79,9 +79,9 @@ (n/= +3 output-3))))] (assert "Can send messages to actors." (case result - (#E;Success outcome) + (#E.Success outcome) outcome - (#E;Error error) + (#E.Error error) false)))) )) diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux index c7e2c42b3..9063af2e7 100644 --- a/stdlib/test/test/lux/concurrency/atom.lux +++ b/stdlib/test/test/lux/concurrency/atom.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad]) @@ -12,23 +12,23 @@ (context: "Atoms" (<| (times +100) (do @ - [value r;nat - swap-value r;nat - set-value r;nat - #let [box (&;atom value)]] + [value r.nat + swap-value r.nat + set-value r.nat + #let [box (&.atom value)]] ($_ seq (test "Can obtain the value of an atom." - (n/= value (io;run (&;read box)))) + (n/= value (io.run (&.read box)))) (test "Can swap the value of an atom." - (and (io;run (&;compare-and-swap value swap-value box)) - (n/= swap-value (io;run (&;read box))))) + (and (io.run (&.compare-and-swap value swap-value box)) + (n/= swap-value (io.run (&.read box))))) (test "Can update the value of an atom." - (exec (io;run (&;update n/inc box)) - (n/= (n/inc swap-value) (io;run (&;read box))))) + (exec (io.run (&.update n/inc box)) + (n/= (n/inc swap-value) (io.run (&.read box))))) (test "Can immediately set the value of an atom." - (exec (io;run (&;write set-value box)) - (n/= set-value (io;run (&;read box))))) + (exec (io.run (&.write set-value box)) + (n/= set-value (io.run (&.read box))))) )))) diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index 5faa404e9..057f155d0 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io #+ IO io] (control ["M" monad #+ do Monad]) @@ -9,18 +9,18 @@ lux/test) (def: (to-channel values) - (-> (List Int) (&;Channel Int)) - (let [_channel (&;channel Int)] - (io;run (do io;Monad<IO> - [_ (M;map @ (function [value] (&;write value _channel)) + (-> (List Int) (&.Channel Int)) + (let [_channel (&.channel Int)] + (io.run (do io.Monad<IO> + [_ (M.map @ (function [value] (&.write value _channel)) values) - _ (&;close _channel)] + _ (&.close _channel)] (wrap _channel))))) (context: "FRP" ($_ seq - (wrap (do P;Monad<Promise> - [elems (&;consume (to-channel (list 0 1 2 3 4 5)))] + (wrap (do P.Monad<Promise> + [elems (&.consume (to-channel (list 0 1 2 3 4 5)))] (assert "Can consume a channel into a list." (case elems (^ (list 0 1 2 3 4 5)) @@ -29,10 +29,10 @@ _ false)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (let [input (to-channel (list 0 1 2 3 4 5)) - output (&;channel Int)] - (exec (&;pipe input output) + (wrap (do P.Monad<Promise> + [elems (&.consume (let [input (to-channel (list 0 1 2 3 4 5)) + output (&.channel Int)] + (exec (&.pipe input output) output)))] (assert "Can pipe one channel into another." (case elems @@ -42,8 +42,8 @@ _ false)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (&;filter i/even? (to-channel (list 0 1 2 3 4 5))))] + (wrap (do P.Monad<Promise> + [elems (&.consume (&.filter i/even? (to-channel (list 0 1 2 3 4 5))))] (assert "Can filter a channel's elements." (case elems (^ (list 0 2 4)) @@ -52,8 +52,8 @@ _ false)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (&;merge (list (to-channel (list 0 1 2 3 4 5)) + (wrap (do P.Monad<Promise> + [elems (&.consume (&.merge (list (to-channel (list 0 1 2 3 4 5)) (to-channel (list 0 -1 -2 -3 -4 -5)))))] (assert "Can merge channels." (case elems @@ -63,13 +63,13 @@ _ false)))) - (wrap (do P;Monad<Promise> - [output (&;fold (function [base input] (P/wrap (i/+ input base))) 0 (to-channel (list 0 1 2 3 4 5)))] + (wrap (do P.Monad<Promise> + [output (&.fold (function [base input] (P/wrap (i/+ input base))) 0 (to-channel (list 0 1 2 3 4 5)))] (assert "Can fold over a channel." (i/= 15 output)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (&;distinct number;Eq<Int> (to-channel (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))] + (wrap (do P.Monad<Promise> + [elems (&.consume (&.distinct number.Eq<Int> (to-channel (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))] (assert "Can avoid immediate repetition in the channel." (case elems (^ (list 0 1 2 3 4 5)) @@ -78,8 +78,8 @@ _ false)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (&;once (:: @ wrap 12345)))] + (wrap (do P.Monad<Promise> + [elems (&.consume (&.once (:: @ wrap 12345)))] (assert "Can convert a promise into a single-value channel." (case elems (^ (list 12345)) @@ -88,8 +88,8 @@ _ false)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (:: &;Functor<Channel> map i/inc (to-channel (list 0 1 2 3 4 5))))] + (wrap (do P.Monad<Promise> + [elems (&.consume (:: &.Functor<Channel> map i/inc (to-channel (list 0 1 2 3 4 5))))] (assert "Functor goes over every element in a channel." (case elems (^ (list 1 2 3 4 5 6)) @@ -98,8 +98,8 @@ _ false)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (let [(^open) &;Applicative<Channel>] + (wrap (do P.Monad<Promise> + [elems (&.consume (let [(^open) &.Applicative<Channel>] (apply (wrap i/inc) (wrap 12345))))] (assert "Applicative works over all channel values." (case elems @@ -109,8 +109,8 @@ _ false)))) - (wrap (do P;Monad<Promise> - [elems (&;consume (do &;Monad<Channel> + (wrap (do P.Monad<Promise> + [elems (&.consume (do &.Monad<Channel> [f (wrap i/inc) a (wrap 12345)] (wrap (f a))))] diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index 26193851a..3be2f03b5 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io #+ IO io] (control ["M" monad #+ do Monad] @@ -11,59 +11,59 @@ (context: "Promises" ($_ seq - (wrap (do &;Monad<Promise> - [running? (&;future (io true))] + (wrap (do &.Monad<Promise> + [running? (&.future (io true))] (assert "Can run IO actions in separate threads." running?))) - (wrap (do &;Monad<Promise> - [_ (&;wait +500)] + (wrap (do &.Monad<Promise> + [_ (&.wait +500)] (assert "Can wait for a specified amount of time." true))) - (wrap (do &;Monad<Promise> - [[left right] (&;seq (&;future (io true)) - (&;future (io false)))] + (wrap (do &.Monad<Promise> + [[left right] (&.seq (&.future (io true)) + (&.future (io false)))] (assert "Can combine promises sequentially." (and left (not right))))) - (wrap (do &;Monad<Promise> - [?left (&;alt (&;delay +100 true) - (&;delay +200 false)) - ?right (&;alt (&;delay +200 true) - (&;delay +100 false))] + (wrap (do &.Monad<Promise> + [?left (&.alt (&.delay +100 true) + (&.delay +200 false)) + ?right (&.alt (&.delay +200 true) + (&.delay +100 false))] (assert "Can combine promises alternatively." (case [?left ?right] - [(#;Left true) (#;Right false)] + [(#.Left true) (#.Right false)] true _ false)))) - (wrap (do &;Monad<Promise> - [?left (&;either (&;delay +100 true) - (&;delay +200 false)) - ?right (&;either (&;delay +200 true) - (&;delay +100 false))] + (wrap (do &.Monad<Promise> + [?left (&.either (&.delay +100 true) + (&.delay +200 false)) + ?right (&.either (&.delay +200 true) + (&.delay +100 false))] (assert "Can combine promises alternatively [Part 2]." (and ?left (not ?right))))) (test "Can poll a promise for its value." - (and (|> (&;poll (&/wrap true)) - (case> (#;Some true) true _ false)) - (|> (&;poll (&;delay +200 true)) - (case> #;None true _ false)))) + (and (|> (&.poll (&/wrap true)) + (case> (#.Some true) true _ false)) + (|> (&.poll (&.delay +200 true)) + (case> #.None true _ false)))) (test "Cannot re-resolve a resolved promise." - (and (not (io;run (&;resolve false (&/wrap true)))) - (io;run (&;resolve true (&;promise Bool))))) + (and (not (io.run (&.resolve false (&/wrap true)))) + (io.run (&.resolve true (&.promise Bool))))) - (wrap (do &;Monad<Promise> - [?none (&;time-out +100 (&;delay +200 true)) - ?some (&;time-out +200 (&;delay +100 true))] + (wrap (do &.Monad<Promise> + [?none (&.time-out +100 (&.delay +200 true)) + ?some (&.time-out +200 (&.delay +100 true))] (assert "Can establish maximum waiting times for promises to be fulfilled." (case [?none ?some] - [#;None (#;Some true)] + [#.None (#.Some true)] true _ diff --git a/stdlib/test/test/lux/concurrency/space.lux b/stdlib/test/test/lux/concurrency/space.lux index 1e71d03c1..dd295501e 100644 --- a/stdlib/test/test/lux/concurrency/space.lux +++ b/stdlib/test/test/lux/concurrency/space.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do]) (concurrency ["T" task] @@ -10,12 +10,12 @@ #Ping #Pong) -(A;actor: #export Player {} +(A.actor: #export Player {} {#hits Nat}) (on: Player Move (reply! who where what state self) (do @ - [_ (S;emit (case what + [_ (S.emit (case what #Ping #Pong #Pong #Ping) where diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index 75354b374..d2e299c50 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad]) @@ -15,21 +15,21 @@ (context: "STM" ($_ seq - (wrap (do promise;Monad<Promise> - [#let [_var (&;var 0) - changes (io;run (&;follow _var))] - output1 (&;commit (&;read _var)) - output2 (&;commit (do &;Monad<STM> - [_ (&;write 5 _var)] - (&;read _var))) - output3 (&;commit (do &;Monad<STM> - [temp (&;read _var) - _ (&;update (i/* 3) _var)] - (&;read _var))) + (wrap (do promise.Monad<Promise> + [#let [_var (&.var 0) + changes (io.run (&.follow _var))] + output1 (&.commit (&.read _var)) + output2 (&.commit (do &.Monad<STM> + [_ (&.write 5 _var)] + (&.read _var))) + output3 (&.commit (do &.Monad<STM> + [temp (&.read _var) + _ (&.update (i/* 3) _var)] + (&.read _var))) ?c1+changes' changes - #let [[c1 changes'] (maybe;default [-1 changes] ?c1+changes')] + #let [[c1 changes'] (maybe.default [-1 changes] ?c1+changes')] ?c2+changes' changes' - #let [[c2 changes'] (maybe;default [-1 changes] ?c2+changes')]] + #let [[c2 changes'] (maybe.default [-1 changes] ?c2+changes')]] (assert "Can read STM vars. Can write STM vars. Can update STM vars. @@ -38,14 +38,14 @@ (i/= 5 output2) (i/= 15 output3) (and (i/= 5 c1) (i/= 15 c2)))))) - (wrap (let [_concurrency-var (&;var 0)] - (do promise;Monad<Promise> - [_ (M;seq @ + (wrap (let [_concurrency-var (&.var 0)] + (do promise.Monad<Promise> + [_ (M.seq @ (map (function [_] - (M;map @ (function [_] (&;commit (&;update i/inc _concurrency-var))) - (list;i/range 1 iterations/processes))) - (list;i/range 1 (nat-to-int promise;concurrency-level)))) - last-val (&;commit (&;read _concurrency-var))] + (M.map @ (function [_] (&.commit (&.update i/inc _concurrency-var))) + (list.i/range 1 iterations/processes))) + (list.i/range 1 (nat-to-int promise.concurrency-level)))) + last-val (&.commit (&.read _concurrency-var))] (assert "Can modify STM vars concurrently from multiple threads." - (i/= (i/* iterations/processes (nat-to-int promise;concurrency-level)) + (i/= (i/* iterations/processes (nat-to-int promise.concurrency-level)) last-val))))))) diff --git a/stdlib/test/test/lux/control/cont.lux b/stdlib/test/test/lux/control/cont.lux index c0fd26ccc..1b9a165ff 100644 --- a/stdlib/test/test/lux/control/cont.lux +++ b/stdlib/test/test/lux/control/cont.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -14,29 +14,29 @@ (context: "Continuations" (<| (times +100) (do @ - [sample r;nat - #let [(^open "&/") &;Monad<Cont>] - elems (r;list +3 r;nat)] + [sample r.nat + #let [(^open "&/") &.Monad<Cont>] + elems (r.list +3 r.nat)] ($_ seq (test "Can run continuations to compute their values." - (n/= sample (&;run (&/wrap sample)))) + (n/= sample (&.run (&/wrap sample)))) (test "Can use functor." - (n/= (n/inc sample) (&;run (&/map n/inc (&/wrap sample))))) + (n/= (n/inc sample) (&.run (&/map n/inc (&/wrap sample))))) (test "Can use applicative." - (n/= (n/inc sample) (&;run (&/apply (&/wrap n/inc) (&/wrap sample))))) + (n/= (n/inc sample) (&.run (&/apply (&/wrap n/inc) (&/wrap sample))))) (test "Can use monad." - (n/= (n/inc sample) (&;run (do &;Monad<Cont> + (n/= (n/inc sample) (&.run (do &.Monad<Cont> [func (wrap n/inc) arg (wrap sample)] (wrap (func arg)))))) (test "Can use the current-continuation as a escape hatch." (n/= (n/* +2 sample) - (&;run (do &;Monad<Cont> - [value (&;call/cc + (&.run (do &.Monad<Cont> + [value (&.call/cc (function [k] (do @ [temp (k sample)] @@ -48,30 +48,30 @@ (test "Can use the current-continuation to build a time machine." (n/= (n/+ +100 sample) - (&;run (do &;Monad<Cont> - [[restart [output idx]] (&;portal [sample +0])] + (&.run (do &.Monad<Cont> + [[restart [output idx]] (&.portal [sample +0])] (if (n/< +10 idx) (restart [(n/+ +10 output) (n/inc idx)]) (wrap output)))))) (test "Can use delimited continuations with shifting." - (let [(^open "&/") &;Monad<Cont> - (^open "L/") (list;Eq<List> number;Eq<Nat>) + (let [(^open "&/") &.Monad<Cont> + (^open "L/") (list.Eq<List> number.Eq<Nat>) visit (: (-> (List Nat) - (&;Cont (List Nat) (List Nat))) + (&.Cont (List Nat) (List Nat))) (function visit [xs] (case xs - #;Nil - (&/wrap #;Nil) + #.Nil + (&/wrap #.Nil) - (#;Cons x xs') - (do &;Monad<Cont> - [output (&;shift (function [k] + (#.Cons x xs') + (do &.Monad<Cont> + [output (&.shift (function [k] (do @ [tail (k xs')] - (wrap (#;Cons x tail)))))] + (wrap (#.Cons x tail)))))] (visit output)))))] (L/= elems - (&;run (&;reset (visit elems)))) + (&.run (&.reset (visit elems)))) )) )))) diff --git a/stdlib/test/test/lux/control/exception.lux b/stdlib/test/test/lux/control/exception.lux index e7adbe93b..40838875e 100644 --- a/stdlib/test/test/lux/control/exception.lux +++ b/stdlib/test/test/lux/control/exception.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -19,13 +19,13 @@ (context: "Exceptions" (<| (times +100) (do @ - [should-throw? r;bool - which? r;bool - should-catch? r;bool - default-val r;nat - some-val r;nat - another-val r;nat - otherwise-val r;nat + [should-throw? r.bool + which? r.bool + should-catch? r.bool + default-val r.nat + some-val r.nat + another-val r.nat + otherwise-val r.nat #let [this-ex (if should-catch? (if which? Some-Exception @@ -38,12 +38,12 @@ another-val) otherwise-val) default-val) - actual (|> (: (E;Error Nat) + actual (|> (: (E.Error Nat) (if should-throw? - (&;throw this-ex "Uh-oh...") - (&;return default-val))) - (&;catch Some-Exception (function [ex] some-val)) - (&;catch Another-Exception (function [ex] another-val)) - (&;otherwise (function [ex] otherwise-val)))]] + (&.throw this-ex "Uh-oh...") + (&.return default-val))) + (&.catch Some-Exception (function [ex] some-val)) + (&.catch Another-Exception (function [ex] another-val)) + (&.otherwise (function [ex] otherwise-val)))]] (test "Catch and otherwhise handlers can properly handle the flow of exception-handling." (n/= expected actual))))) diff --git a/stdlib/test/test/lux/control/interval.lux b/stdlib/test/test/lux/control/interval.lux index 1dc6e0afa..05566f464 100644 --- a/stdlib/test/test/lux/control/interval.lux +++ b/stdlib/test/test/lux/control/interval.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux lux/test (lux (control ["M" monad #+ do Monad] @@ -14,35 +14,35 @@ (context: "Equality." (<| (times +100) (do @ - [bottom r;int - top r;int - #let [(^open "&/") &;Eq<Interval>]] + [bottom r.int + top r.int + #let [(^open "&/") &.Eq<Interval>]] ($_ seq (test "Every interval is equal to itself." - (and (let [self (&;between number;Enum<Int> bottom top)] + (and (let [self (&.between number.Enum<Int> bottom top)] (&/= self self)) - (let [self (&;between number;Enum<Int> top bottom)] + (let [self (&.between number.Enum<Int> top bottom)] (&/= self self)) - (let [self (&;singleton number;Enum<Int> bottom)] + (let [self (&.singleton number.Enum<Int> bottom)] (&/= self self)))))))) (context: "Boundaries" (<| (times +100) (do @ - [bottom r;int - top r;int - #let [interval (&;between number;Enum<Int> bottom top)]] + [bottom r.int + top r.int + #let [interval (&.between number.Enum<Int> bottom top)]] ($_ seq (test "Every boundary value belongs to it's interval." - (and (&;within? interval bottom) - (&;within? interval top))) + (and (&.within? interval bottom) + (&.within? interval top))) (test "Every interval starts with its bottom." - (&;starts-with? bottom interval)) + (&.starts-with? bottom interval)) (test "Every interval ends with its top." - (&;ends-with? top interval)) + (&.ends-with? top interval)) (test "The boundary values border the interval." - (and (&;borders? interval bottom) - (&;borders? interval top))) + (and (&.borders? interval bottom) + (&.borders? interval top))) )))) (def: (list-to-4tuple list) @@ -57,27 +57,27 @@ (do-template [<name> <cmp>] [(def: <name> - (r;Random (&;Interval Int)) - (do r;Monad<Random> - [bottom r;int - top (|> r;int (r;filter (|>> (i/= bottom) not)))] + (r.Random (&.Interval Int)) + (do r.Monad<Random> + [bottom r.int + top (|> r.int (r.filter (|>> (i/= bottom) not)))] (if (<cmp> top bottom) - (wrap (&;between number;Enum<Int> bottom top)) - (wrap (&;between number;Enum<Int> top bottom)))))] + (wrap (&.between number.Enum<Int> bottom top)) + (wrap (&.between number.Enum<Int> top bottom)))))] [gen-inner i/<] [gen-outer i/>] ) (def: gen-singleton - (r;Random (&;Interval Int)) - (do r;Monad<Random> - [point r;int] - (wrap (&;singleton number;Enum<Int> point)))) + (r.Random (&.Interval Int)) + (do r.Monad<Random> + [point r.int] + (wrap (&.singleton number.Enum<Int> point)))) (def: gen-interval - (r;Random (&;Interval Int)) - ($_ r;either + (r.Random (&.Interval Int)) + ($_ r.either gen-inner gen-outer gen-singleton)) @@ -92,16 +92,16 @@ right-singleton gen-singleton left-outer gen-outer right-outer gen-outer - #let [(^open "&/") &;Eq<Interval>]] + #let [(^open "&/") &.Eq<Interval>]] ($_ seq (test "The union of an interval to itself yields the same interval." - (&/= some-interval (&;union some-interval some-interval))) + (&/= some-interval (&.union some-interval some-interval))) (test "The union of 2 inner intervals is another inner interval." - (&;inner? (&;union left-inner right-inner))) + (&.inner? (&.union left-inner right-inner))) (test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." - (if (&;overlaps? (&;complement left-outer) (&;complement right-outer)) - (&;outer? (&;union left-outer right-outer)) - (&;inner? (&;union left-outer right-outer)))) + (if (&.overlaps? (&.complement left-outer) (&.complement right-outer)) + (&.outer? (&.union left-outer right-outer)) + (&.inner? (&.union left-outer right-outer)))) )))) (context: "Intersections" @@ -114,85 +114,85 @@ right-singleton gen-singleton left-outer gen-outer right-outer gen-outer - #let [(^open "&/") &;Eq<Interval>]] + #let [(^open "&/") &.Eq<Interval>]] ($_ seq (test "The intersection of an interval to itself yields the same interval." - (&/= some-interval (&;intersection some-interval some-interval))) + (&/= some-interval (&.intersection some-interval some-interval))) (test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." - (if (&;overlaps? left-inner right-inner) - (&;inner? (&;intersection left-inner right-inner)) - (&;outer? (&;intersection left-inner right-inner)))) + (if (&.overlaps? left-inner right-inner) + (&.inner? (&.intersection left-inner right-inner)) + (&.outer? (&.intersection left-inner right-inner)))) (test "The intersection of 2 outer intervals is another outer interval." - (&;outer? (&;intersection left-outer right-outer))) + (&.outer? (&.intersection left-outer right-outer))) )))) (context: "Complement" (<| (times +100) (do @ [some-interval gen-interval - #let [(^open "&/") &;Eq<Interval>]] + #let [(^open "&/") &.Eq<Interval>]] ($_ seq (test "The complement of a complement is the same as the original." - (&/= some-interval (|> some-interval &;complement &;complement))) + (&/= some-interval (|> some-interval &.complement &.complement))) (test "The complement of an interval does not overlap it." - (not (&;overlaps? some-interval (&;complement some-interval)))) + (not (&.overlaps? some-interval (&.complement some-interval)))) )))) (context: "Positioning/location" (<| (times +100) (do @ - [[l m r] (|> (r;set number;Hash<Int> +3 r;int) - (:: @ map (|>> S;to-list - (L;sort i/<) + [[l m r] (|> (r.set number.Hash<Int> +3 r.int) + (:: @ map (|>> S.to-list + (L.sort i/<) (case> (^ (list b t1 t2)) [b t1 t2] _ (undefined))))) - #let [left (&;singleton number;Enum<Int> l) - right (&;singleton number;Enum<Int> r)]] + #let [left (&.singleton number.Enum<Int> l) + right (&.singleton number.Enum<Int> r)]] ($_ seq (test "'precedes?' and 'succeeds?' are symetric." - (and (&;precedes? right left) - (&;succeeds? left right))) + (and (&.precedes? right left) + (&.succeeds? left right))) (test "Can check if an interval is before or after some element." - (and (&;before? m left) - (&;after? m right))) + (and (&.before? m left) + (&.after? m right))) )))) (context: "Touching intervals" (<| (times +100) (do @ - [[b t1 t2] (|> (r;set number;Hash<Int> +3 r;int) - (:: @ map (|>> S;to-list - (L;sort i/<) + [[b t1 t2] (|> (r.set number.Hash<Int> +3 r.int) + (:: @ map (|>> S.to-list + (L.sort i/<) (case> (^ (list b t1 t2)) [b t1 t2] _ (undefined))))) - #let [int-left (&;between number;Enum<Int> t1 t2) - int-right (&;between number;Enum<Int> b t1)]] + #let [int-left (&.between number.Enum<Int> t1 t2) + int-right (&.between number.Enum<Int> b t1)]] ($_ seq (test "An interval meets another if it's top is the other's bottom." - (&;meets? int-left int-right)) + (&.meets? int-left int-right)) (test "Two intervals touch one another if any one meets the other." - (&;touches? int-left int-right)) + (&.touches? int-left int-right)) (test "Can check if 2 intervals start together." - (&;starts? (&;between number;Enum<Int> b t2) - (&;between number;Enum<Int> b t1))) + (&.starts? (&.between number.Enum<Int> b t2) + (&.between number.Enum<Int> b t1))) (test "Can check if 2 intervals finish together." - (&;finishes? (&;between number;Enum<Int> b t2) - (&;between number;Enum<Int> t1 t2))) + (&.finishes? (&.between number.Enum<Int> b t2) + (&.between number.Enum<Int> t1 t2))) )))) (context: "Nesting & overlap" (<| (times +100) (do @ [some-interval gen-interval - [x0 x1 x2 x3] (|> (r;set number;Hash<Int> +4 r;int) - (:: @ map (|>> S;to-list - (L;sort i/<) + [x0 x1 x2 x3] (|> (r.set number.Hash<Int> +4 r.int) + (:: @ map (|>> S.to-list + (L.sort i/<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] @@ -200,34 +200,34 @@ (undefined)))))] ($_ seq (test "Every interval is nested into itself." - (&;nested? some-interval some-interval)) + (&.nested? some-interval some-interval)) (test "No interval overlaps with itself." - (not (&;overlaps? some-interval some-interval))) - (let [small-inner (&;between number;Enum<Int> x1 x2) - large-inner (&;between number;Enum<Int> x0 x3)] + (not (&.overlaps? some-interval some-interval))) + (let [small-inner (&.between number.Enum<Int> x1 x2) + large-inner (&.between number.Enum<Int> x0 x3)] (test "Inner intervals can be nested inside one another." - (and (&;nested? large-inner small-inner) - (not (&;nested? small-inner large-inner))))) - (let [left-inner (&;between number;Enum<Int> x0 x2) - right-inner (&;between number;Enum<Int> x1 x3)] + (and (&.nested? large-inner small-inner) + (not (&.nested? small-inner large-inner))))) + (let [left-inner (&.between number.Enum<Int> x0 x2) + right-inner (&.between number.Enum<Int> x1 x3)] (test "Inner intervals can overlap one another." - (and (&;overlaps? left-inner right-inner) - (&;overlaps? right-inner left-inner)))) - (let [small-outer (&;between number;Enum<Int> x2 x1) - large-outer (&;between number;Enum<Int> x3 x0)] + (and (&.overlaps? left-inner right-inner) + (&.overlaps? right-inner left-inner)))) + (let [small-outer (&.between number.Enum<Int> x2 x1) + large-outer (&.between number.Enum<Int> x3 x0)] (test "Outer intervals can be nested inside one another." - (and (&;nested? small-outer large-outer) - (not (&;nested? large-outer small-outer))))) - (let [left-inner (&;between number;Enum<Int> x0 x1) - right-inner (&;between number;Enum<Int> x2 x3) - outer (&;between number;Enum<Int> x0 x3)] + (and (&.nested? small-outer large-outer) + (not (&.nested? large-outer small-outer))))) + (let [left-inner (&.between number.Enum<Int> x0 x1) + right-inner (&.between number.Enum<Int> x2 x3) + outer (&.between number.Enum<Int> x0 x3)] (test "Inners can be nested inside outers." - (and (&;nested? outer left-inner) - (&;nested? outer right-inner)))) - (let [left-inner (&;between number;Enum<Int> x0 x2) - right-inner (&;between number;Enum<Int> x1 x3) - outer (&;between number;Enum<Int> x1 x2)] + (and (&.nested? outer left-inner) + (&.nested? outer right-inner)))) + (let [left-inner (&.between number.Enum<Int> x0 x2) + right-inner (&.between number.Enum<Int> x1 x3) + outer (&.between number.Enum<Int> x1 x2)] (test "Inners can overlap outers." - (and (&;overlaps? outer left-inner) - (&;overlaps? outer right-inner)))) + (and (&.overlaps? outer left-inner) + (&.overlaps? outer right-inner)))) )))) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux index b5ec72dc5..64e8fac32 100644 --- a/stdlib/test/test/lux/control/parser.lux +++ b/stdlib/test/test/lux/control/parser.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -19,42 +19,42 @@ ## [Utils] (def: (should-fail input) - (All [a] (-> (E;Error a) Bool)) + (All [a] (-> (E.Error a) Bool)) (case input - (#E;Error _) true + (#E.Error _) true _ false)) (def: (enforced? parser input) - (All [s] (-> (&;Parser s Unit) s Bool)) - (case (&;run input parser) - (#E;Success [_ []]) + (All [s] (-> (&.Parser s Unit) s Bool)) + (case (&.run input parser) + (#E.Success [_ []]) true _ false)) (def: (found? parser input) - (All [s] (-> (&;Parser s Bool) s Bool)) - (case (&;run input parser) - (#E;Success [_ true]) + (All [s] (-> (&.Parser s Bool) s Bool)) + (case (&.run input parser) + (#E.Success [_ true]) true _ false)) (def: (is? Eq<a> test parser input) - (All [s a] (-> (Eq a) a (&;Parser s a) s Bool)) - (case (&;run input parser) - (#E;Success [_ output]) + (All [s a] (-> (Eq a) a (&.Parser s a) s Bool)) + (case (&.run input parser) + (#E.Success [_ output]) (:: Eq<a> = test output) _ false)) (def: (fails? input) - (All [a] (-> (E;Error a) Bool)) + (All [a] (-> (E.Error a) Bool)) (case input - (#E;Error _) + (#E.Error _) true _ @@ -62,7 +62,7 @@ (syntax: (match pattern input) (wrap (list (` (case (~ input) - (^ (#E;Success [(~' _) (~ pattern)])) + (^ (#E.Success [(~' _) (~ pattern)])) true (~' _) @@ -72,116 +72,116 @@ (context: "Assertions" (test "Can make assertions while parsing." (and (match [] - (&;run (list (code;bool true) (code;int 123)) - (&;assert "yolo" true))) - (fails? (&;run (list (code;bool true) (code;int 123)) - (&;assert "yolo" false)))))) + (&.run (list (code.bool true) (code.int 123)) + (&.assert "yolo" true))) + (fails? (&.run (list (code.bool true) (code.int 123)) + (&.assert "yolo" false)))))) (context: "Combinators [Part 1]" ($_ seq (test "Can optionally succeed with some parser." - (and (match (#;Some +123) - (&;run (list (code;nat +123)) - (&;maybe s;nat))) - (match #;None - (&;run (list (code;int -123)) - (&;maybe s;nat))))) + (and (match (#.Some +123) + (&.run (list (code.nat +123)) + (&.maybe s.nat))) + (match #.None + (&.run (list (code.int -123)) + (&.maybe s.nat))))) (test "Can apply a parser 0 or more times." (and (match (list +123 +456 +789) - (&;run (list (code;nat +123) (code;nat +456) (code;nat +789)) - (&;some s;nat))) + (&.run (list (code.nat +123) (code.nat +456) (code.nat +789)) + (&.some s.nat))) (match (list) - (&;run (list (code;int -123)) - (&;some s;nat))))) + (&.run (list (code.int -123)) + (&.some s.nat))))) (test "Can apply a parser 1 or more times." (and (match (list +123 +456 +789) - (&;run (list (code;nat +123) (code;nat +456) (code;nat +789)) - (&;many s;nat))) + (&.run (list (code.nat +123) (code.nat +456) (code.nat +789)) + (&.many s.nat))) (match (list +123) - (&;run (list (code;nat +123)) - (&;many s;nat))) - (fails? (&;run (list (code;int -123)) - (&;many s;nat))))) + (&.run (list (code.nat +123)) + (&.many s.nat))) + (fails? (&.run (list (code.int -123)) + (&.many s.nat))))) (test "Can use either parser." - (let [positive (: (s;Syntax Int) - (do &;Monad<Parser> - [value s;int - _ (&;assert "" (i/> 0 value))] + (let [positive (: (s.Syntax Int) + (do &.Monad<Parser> + [value s.int + _ (&.assert "" (i/> 0 value))] (wrap value)))] (and (match 123 - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;either positive s;int))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.either positive s.int))) (match -123 - (&;run (list (code;int -123) (code;int 456) (code;int 789)) - (&;either positive s;int))) - (fails? (&;run (list (code;bool true) (code;int 456) (code;int 789)) - (&;either positive s;int)))))) + (&.run (list (code.int -123) (code.int 456) (code.int 789)) + (&.either positive s.int))) + (fails? (&.run (list (code.bool true) (code.int 456) (code.int 789)) + (&.either positive s.int)))))) (test "Can create the opposite/negation of any parser." - (and (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;not s;int))) + (and (fails? (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.not s.int))) (match [] - (&;run (list (code;bool true) (code;int 456) (code;int 789)) - (&;not s;int))))) + (&.run (list (code.bool true) (code.int 456) (code.int 789)) + (&.not s.int))))) )) (context: "Combinators Part [2]" ($_ seq (test "Can fail at will." - (should-fail (&;run (list) - (&;fail "Well, it really SHOULD fail...")))) + (should-fail (&.run (list) + (&.fail "Well, it really SHOULD fail...")))) (test "Can apply a parser N times." (and (match (list 123 456 789) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;exactly +3 s;int))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.exactly +3 s.int))) (match (list 123 456) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;exactly +2 s;int))) - (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;exactly +4 s;int))))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.exactly +2 s.int))) + (fails? (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.exactly +4 s.int))))) (test "Can apply a parser at-least N times." (and (match (list 123 456 789) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;at-least +3 s;int))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.at-least +3 s.int))) (match (list 123 456 789) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;at-least +2 s;int))) - (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;at-least +4 s;int))))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.at-least +2 s.int))) + (fails? (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.at-least +4 s.int))))) (test "Can apply a parser at-most N times." (and (match (list 123 456 789) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;at-most +3 s;int))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.at-most +3 s.int))) (match (list 123 456) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;at-most +2 s;int))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.at-most +2 s.int))) (match (list 123 456 789) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;at-most +4 s;int))))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.at-most +4 s.int))))) (test "Can apply a parser between N and M times." (and (match (list 123 456 789) - (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;between +3 +10 s;int))) - (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) - (&;between +4 +10 s;int))))) + (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.between +3 +10 s.int))) + (fails? (&.run (list (code.int 123) (code.int 456) (code.int 789)) + (&.between +4 +10 s.int))))) (test "Can parse while taking separators into account." (and (match (list 123 456 789) - (&;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789)) - (&;sep-by (s;this (' "YOLO")) s;int))) + (&.run (list (code.int 123) (code.text "YOLO") (code.int 456) (code.text "YOLO") (code.int 789)) + (&.sep-by (s.this (' "YOLO")) s.int))) (match (list 123 456) - (&;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789)) - (&;sep-by (s;this (' "YOLO")) s;int))))) + (&.run (list (code.int 123) (code.text "YOLO") (code.int 456) (code.int 789)) + (&.sep-by (s.this (' "YOLO")) s.int))))) (test "Can obtain the whole of the remaining input." - (|> &;remaining - (&;run (list (code;int 123) (code;int 456) (code;int 789))) - (match (list [_ (#;Int 123)] [_ (#;Int 456)] [_ (#;Int 789)])))) + (|> &.remaining + (&.run (list (code.int 123) (code.int 456) (code.int 789))) + (match (list [_ (#.Int 123)] [_ (#.Int 456)] [_ (#.Int 789)])))) )) diff --git a/stdlib/test/test/lux/control/pipe.lux b/stdlib/test/test/lux/control/pipe.lux index 9147f501e..545640030 100644 --- a/stdlib/test/test/lux/control/pipe.lux +++ b/stdlib/test/test/lux/control/pipe.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] diff --git a/stdlib/test/test/lux/control/reader.lux b/stdlib/test/test/lux/control/reader.lux index 804660a2c..38b4f2893 100644 --- a/stdlib/test/test/lux/control/reader.lux +++ b/stdlib/test/test/lux/control/reader.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -11,27 +11,27 @@ (context: "Readers" ($_ seq - (test "" (i/= 123 (&;run 123 &;ask))) - (test "" (i/= 246 (&;run 123 (&;local (i/* 2) &;ask)))) - (test "" (i/= 134 (&;run 123 (:: &;Functor<Reader> map i/inc (i/+ 10))))) - (test "" (i/= 10 (&;run 123 (:: &;Applicative<Reader> wrap 10)))) - (test "" (i/= 30 (&;run 123 (let [(^open "&/") &;Applicative<Reader>] + (test "" (i/= 123 (&.run 123 &.ask))) + (test "" (i/= 246 (&.run 123 (&.local (i/* 2) &.ask)))) + (test "" (i/= 134 (&.run 123 (:: &.Functor<Reader> map i/inc (i/+ 10))))) + (test "" (i/= 10 (&.run 123 (:: &.Applicative<Reader> wrap 10)))) + (test "" (i/= 30 (&.run 123 (let [(^open "&/") &.Applicative<Reader>] (&/apply (&/wrap (i/+ 10)) (&/wrap 20)))))) - (test "" (i/= 30 (&;run 123 (do &;Monad<Reader> + (test "" (i/= 30 (&.run 123 (do &.Monad<Reader> [f (wrap i/+) x (wrap 10) y (wrap 20)] (wrap (f x y)))))))) (context: "Monad transformer" - (let [(^open "io/") io;Monad<IO>] + (let [(^open "io/") io.Monad<IO>] (test "Can add reader functionality to any monad." - (|> (do (&;ReaderT io;Monad<IO>) - [a (&;lift (io/wrap 123)) + (|> (do (&.ReaderT io.Monad<IO>) + [a (&.lift (io/wrap 123)) b (wrap 456)] (wrap (i/+ a b))) - (&;run "") - io;run + (&.run "") + io.run (case> 579 true _ false))) )) diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux index 070f3425c..4457952a1 100644 --- a/stdlib/test/test/lux/control/state.lux +++ b/stdlib/test/test/lux/control/state.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -12,51 +12,51 @@ lux/test) (def: (with-conditions [state output] computation) - (-> [Nat Nat] (&;State Nat Nat) Bool) + (-> [Nat Nat] (&.State Nat Nat) Bool) (|> computation - (&;run state) - product;right + (&.run state) + product.right (n/= output))) (context: "Basics" (<| (times +100) (do @ - [state r;nat - value r;nat] + [state r.nat + value r.nat] ($_ seq (test "Can get the state as a value." (with-conditions [state state] - &;get)) + &.get)) (test "Can replace the state." (with-conditions [state value] - (do &;Monad<State> - [_ (&;put value)] - &;get))) + (do &.Monad<State> + [_ (&.put value)] + &.get))) (test "Can update the state." (with-conditions [state (n/* value state)] - (do &;Monad<State> - [_ (&;update (n/* value))] - &;get))) + (do &.Monad<State> + [_ (&.update (n/* value))] + &.get))) (test "Can use the state." (with-conditions [state (n/inc state)] - (&;use n/inc))) + (&.use n/inc))) (test "Can use a temporary (local) state." (with-conditions [state (n/* value state)] - (&;local (n/* value) - &;get))) + (&.local (n/* value) + &.get))) )))) (context: "Structures" (<| (times +100) (do @ - [state r;nat - value r;nat] + [state r.nat + value r.nat] ($_ seq (test "Can use functor." (with-conditions [state (n/inc state)] - (:: &;Functor<State> map n/inc &;get))) + (:: &.Functor<State> map n/inc &.get))) (test "Can use applicative." - (let [(^open "&/") &;Applicative<State>] + (let [(^open "&/") &.Applicative<State>] (and (with-conditions [state value] (&/wrap value)) (with-conditions [state (n/+ value value)] @@ -64,8 +64,8 @@ (&/wrap value)))))) (test "Can use monad." (with-conditions [state (n/+ value value)] - (: (&;State Nat Nat) - (do &;Monad<State> + (: (&.State Nat Nat) + (do &.Monad<State> [f (wrap n/+) x (wrap value) y (wrap value)] @@ -75,18 +75,18 @@ (context: "Monad transformer" (<| (times +100) (do @ - [state r;nat - left r;nat - right r;nat] - (let [(^open "io/") io;Monad<IO>] + [state r.nat + left r.nat + right r.nat] + (let [(^open "io/") io.Monad<IO>] (test "Can add state functionality to any monad." - (|> (: (&;State' io;IO Nat Nat) - (do (&;StateT io;Monad<IO>) - [a (&;lift io;Monad<IO> (io/wrap left)) + (|> (: (&.State' io.IO Nat Nat) + (do (&.StateT io.Monad<IO>) + [a (&.lift io.Monad<IO> (io/wrap left)) b (wrap right)] (wrap (n/+ a b)))) - (&;run' state) - io;run + (&.run' state) + io.run (case> [state' output'] (and (n/= state state') (n/= (n/+ left right) output'))))) @@ -95,19 +95,19 @@ (context: "Loops" (<| (times +100) (do @ - [limit (|> r;nat (:: @ map (n/% +10))) - #let [condition (do &;Monad<State> - [state &;get] + [limit (|> r.nat (:: @ map (n/% +10))) + #let [condition (do &.Monad<State> + [state &.get] (wrap (n/< limit state)))]] ($_ seq (test "'while' will only execute if the condition is true." - (|> (&;while condition (&;update n/inc)) - (&;run +0) + (|> (&.while condition (&.update n/inc)) + (&.run +0) (case> [state' output'] (n/= limit state')))) (test "'do-while' will execute at least once." - (|> (&;do-while condition (&;update n/inc)) - (&;run +0) + (|> (&.do-while condition (&.update n/inc)) + (&.run +0) (case> [state' output'] (or (n/= limit state') (and (n/= +0 limit) diff --git a/stdlib/test/test/lux/control/writer.lux b/stdlib/test/test/lux/control/writer.lux index cbabbb6cd..42a5f9543 100644 --- a/stdlib/test/test/lux/control/writer.lux +++ b/stdlib/test/test/lux/control/writer.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -10,31 +10,31 @@ lux/test) (context: "Writer." - (let [(^open "&/") (&;Monad<Writer> text;Monoid<Text>)] + (let [(^open "&/") (&.Monad<Writer> text.Monoid<Text>)] ($_ seq (test "Functor respects Writer." - (i/= 11 (product;right (&/map i/inc ["" 10])))) + (i/= 11 (product.right (&/map i/inc ["" 10])))) (test "Applicative respects Writer." - (and (i/= 20 (product;right (&/wrap 20))) - (i/= 30 (product;right (&/apply (&/wrap (i/+ 10)) (&/wrap 20)))))) + (and (i/= 20 (product.right (&/wrap 20))) + (i/= 30 (product.right (&/apply (&/wrap (i/+ 10)) (&/wrap 20)))))) (test "Monad respects Writer." - (i/= 30 (product;right (do (&;Monad<Writer> text;Monoid<Text>) + (i/= 30 (product.right (do (&.Monad<Writer> text.Monoid<Text>) [f (wrap i/+) a (wrap 10) b (wrap 20)] (wrap (f a b)))))) (test "Can log any value." - (Text/= "YOLO" (product;left (&;log "YOLO")))) + (Text/= "YOLO" (product.left (&.log "YOLO")))) ))) (context: "Monad transformer" - (let [lift (&;lift text;Monoid<Text> io;Monad<IO>) - (^open "io/") io;Monad<IO>] + (let [lift (&.lift text.Monoid<Text> io.Monad<IO>) + (^open "io/") io.Monad<IO>] (test "Can add writer functionality to any monad." - (|> (io;run (do (&;WriterT text;Monoid<Text> io;Monad<IO>) + (|> (io.run (do (&.WriterT text.Monoid<Text> io.Monad<IO>) [a (lift (io/wrap 123)) b (wrap 456)] (wrap (i/+ a b)))) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux index ac80f9b06..ca9e21d86 100644 --- a/stdlib/test/test/lux/data/bit.lux +++ b/stdlib/test/test/lux/data/bit.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad]) @@ -10,62 +10,62 @@ (context: "Bitwise operations." (<| (times +100) (do @ - [pattern r;nat - idx (:: @ map (n/% &;width) r;nat)] + [pattern r.nat + idx (:: @ map (n/% &.width) r.nat)] ($_ seq (test "Clearing and settings bits should alter the count." - (and (n/< (&;count (&;set idx pattern)) - (&;count (&;clear idx pattern))) - (n/<= (&;count pattern) - (&;count (&;clear idx pattern))) - (n/>= (&;count pattern) - (&;count (&;set idx pattern))))) + (and (n/< (&.count (&.set idx pattern)) + (&.count (&.clear idx pattern))) + (n/<= (&.count pattern) + (&.count (&.clear idx pattern))) + (n/>= (&.count pattern) + (&.count (&.set idx pattern))))) (test "Can query whether a bit is set." - (and (or (and (&;set? idx pattern) - (not (&;set? idx (&;clear idx pattern)))) - (and (not (&;set? idx pattern)) - (&;set? idx (&;set idx pattern)))) + (and (or (and (&.set? idx pattern) + (not (&.set? idx (&.clear idx pattern)))) + (and (not (&.set? idx pattern)) + (&.set? idx (&.set idx pattern)))) - (or (and (&;set? idx pattern) - (not (&;set? idx (&;flip idx pattern)))) - (and (not (&;set? idx pattern)) - (&;set? idx (&;flip idx pattern)))))) + (or (and (&.set? idx pattern) + (not (&.set? idx (&.flip idx pattern)))) + (and (not (&.set? idx pattern)) + (&.set? idx (&.flip idx pattern)))))) (test "The negation of a bit pattern should have a complementary bit count." - (n/= &;width - (n/+ (&;count pattern) - (&;count (&;not pattern))))) + (n/= &.width + (n/+ (&.count pattern) + (&.count (&.not pattern))))) (test "Can do simple binary boolean logic." (and (n/= +0 - (&;and pattern - (&;not pattern))) - (n/= (&;not +0) - (&;or pattern - (&;not pattern))) - (n/= (&;not +0) - (&;xor pattern - (&;not pattern))) + (&.and pattern + (&.not pattern))) + (n/= (&.not +0) + (&.or pattern + (&.not pattern))) + (n/= (&.not +0) + (&.xor pattern + (&.not pattern))) (n/= +0 - (&;xor pattern + (&.xor pattern pattern)))) (test "rotate-left and rotate-right are inverses of one another." (and (|> pattern - (&;rotate-left idx) - (&;rotate-right idx) + (&.rotate-left idx) + (&.rotate-right idx) (n/= pattern)) (|> pattern - (&;rotate-right idx) - (&;rotate-left idx) + (&.rotate-right idx) + (&.rotate-left idx) (n/= pattern)))) (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." (and (|> pattern - (&;rotate-left &;width) + (&.rotate-left &.width) (n/= pattern)) (|> pattern - (&;rotate-right &;width) + (&.rotate-right &.width) (n/= pattern)))) (test "Shift right respect the sign of ints." (let [value (nat-to-int pattern)] (if (i/< 0 value) - (i/< 0 (&;signed-shift-right idx value)) - (i/>= 0 (&;signed-shift-right idx value))))) + (i/< 0 (&.signed-shift-right idx value)) + (i/>= 0 (&.signed-shift-right idx value))))) )))) diff --git a/stdlib/test/test/lux/data/bool.lux b/stdlib/test/test/lux/data/bool.lux index 0336c15e7..d7bc88e87 100644 --- a/stdlib/test/test/lux/data/bool.lux +++ b/stdlib/test/test/lux/data/bool.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["M" monad #+ do Monad]) [io] @@ -9,7 +9,7 @@ (context: "Boolean operations." (<| (times +100) (do @ - [value r;bool] + [value r.bool] (test "" (and (not (and value (not value))) (or value (not value)) @@ -27,9 +27,9 @@ (case (|> value (:: Codec<Text,Bool> encode) (:: Codec<Text,Bool> decode)) - (#;Right dec-value) + (#.Right dec-value) (:: Eq<Bool> = value dec-value) - (#;Left _) + (#.Left _) false) ))))) diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux index 6d30f3e1e..cd834a41e 100644 --- a/stdlib/test/test/lux/data/coll/array.lux +++ b/stdlib/test/test/lux/data/coll/array.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] pipe) @@ -11,98 +11,98 @@ lux/test) (def: bounded-size - (r;Random Nat) - (|> r;nat - (:: r;Monad<Random> map (|>> (n/% +100) (n/+ +1))))) + (r.Random Nat) + (|> r.nat + (:: r.Monad<Random> map (|>> (n/% +100) (n/+ +1))))) (context: "Arrays and their copies" (<| (times +100) (do @ [size bounded-size - original (r;array size r;nat) - #let [clone (@;clone original) + original (r.array size r.nat) + #let [clone (@.clone original) copy (: (Array Nat) - (@;new size)) + (@.new size)) manual-copy (: (Array Nat) - (@;new size))]] + (@.new size))]] ($_ seq (test "Size function must correctly return size of array." - (n/= size (@;size original))) + (n/= size (@.size original))) (test "Cloning an array should yield and identical array, but not the same one." - (and (:: (@;Eq<Array> number;Eq<Nat>) = original clone) + (and (:: (@.Eq<Array> number.Eq<Nat>) = original clone) (not (is original clone)))) (test "Full-range manual copies should give the same result as cloning." - (exec (@;copy size +0 original +0 copy) - (and (:: (@;Eq<Array> number;Eq<Nat>) = original copy) + (exec (@.copy size +0 original +0 copy) + (and (:: (@.Eq<Array> number.Eq<Nat>) = original copy) (not (is original copy))))) (test "Array folding should go over all values." - (exec (:: @;Fold<Array> fold + (exec (:: @.Fold<Array> fold (function [x idx] - (exec (@;write idx x manual-copy) + (exec (@.write idx x manual-copy) (n/inc idx))) +0 original) - (:: (@;Eq<Array> number;Eq<Nat>) = original manual-copy))) + (:: (@.Eq<Array> number.Eq<Nat>) = original manual-copy))) (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values." (|> original - @;to-list @;from-list - (:: (@;Eq<Array> number;Eq<Nat>) = original))) + @.to-list @.from-list + (:: (@.Eq<Array> number.Eq<Nat>) = original))) )))) (context: "Array mutation" (<| (times +100) (do @ [size bounded-size - idx (:: @ map (n/% size) r;nat) - array (|> (r;array size r;nat) - (r;filter (|>> @;to-list (list;any? n/odd?)))) - #let [value (maybe;assume (@;read idx array))]] + idx (:: @ map (n/% size) r.nat) + array (|> (r.array size r.nat) + (r.filter (|>> @.to-list (list.any? n/odd?)))) + #let [value (maybe.assume (@.read idx array))]] ($_ seq (test "Shouldn't be able to find a value in an unoccupied cell." - (case (@;read idx (@;delete idx array)) - (#;Some _) false - #;None true)) + (case (@.read idx (@.delete idx array)) + (#.Some _) false + #.None true)) (test "You should be able to access values put into the array." - (case (@;read idx (@;write idx value array)) - (#;Some value') (n/= value' value) - #;None false)) + (case (@.read idx (@.write idx value array)) + (#.Some value') (n/= value' value) + #.None false)) (test "All cells should be occupied on a full array." - (and (n/= size (@;occupied array)) - (n/= +0 (@;vacant array)))) + (and (n/= size (@.occupied array)) + (n/= +0 (@.vacant array)))) (test "Filtering mutates the array to remove invalid values." - (exec (@;filter n/even? array) - (and (n/< size (@;occupied array)) - (n/> +0 (@;vacant array)) - (n/= size (n/+ (@;occupied array) - (@;vacant array)))))) + (exec (@.filter n/even? array) + (and (n/< size (@.occupied array)) + (n/> +0 (@.vacant array)) + (n/= size (n/+ (@.occupied array) + (@.vacant array)))))) )))) (context: "Finding values." (<| (times +100) (do @ [size bounded-size - array (|> (r;array size r;nat) - (r;filter (|>> @;to-list (list;any? n/even?))))] + array (|> (r.array size r.nat) + (r.filter (|>> @.to-list (list.any? n/even?))))] ($_ seq (test "Can find values inside arrays." - (|> (@;find n/even? array) - (case> (#;Some _) true - #;None false))) + (|> (@.find n/even? array) + (case> (#.Some _) true + #.None false))) (test "Can find values inside arrays (with access to indices)." - (|> (@;find+ (function [idx n] + (|> (@.find+ (function [idx n] (and (n/even? n) (n/< size idx))) array) - (case> (#;Some _) true - #;None false))))))) + (case> (#.Some _) true + #.None false))))))) (context: "Functor" (<| (times +100) (do @ [size bounded-size - array (r;array size r;nat)] - (let [(^open) @;Functor<Array> - (^open) (@;Eq<Array> number;Eq<Nat>)] + array (r.array size r.nat)] + (let [(^open) @.Functor<Array> + (^open) (@.Eq<Array> number.Eq<Nat>)] ($_ seq (test "Functor shouldn't alter original array." (let [copy (map id array)] @@ -119,22 +119,22 @@ (do @ [sizeL bounded-size sizeR bounded-size - left (r;array sizeL r;nat) - right (r;array sizeR r;nat) - #let [(^open) @;Monoid<Array> - (^open) (@;Eq<Array> number;Eq<Nat>) + left (r.array sizeL r.nat) + right (r.array sizeR r.nat) + #let [(^open) @.Monoid<Array> + (^open) (@.Eq<Array> number.Eq<Nat>) fusion (compose left right)]] ($_ seq (test "Appending two arrays should produce a new one twice as large." - (n/= (n/+ sizeL sizeR) (@;size fusion))) + (n/= (n/+ sizeL sizeR) (@.size fusion))) (test "First elements of fused array should equal the first array." (|> (: (Array Nat) - (@;new sizeL)) - (@;copy sizeL +0 fusion +0) + (@.new sizeL)) + (@.copy sizeL +0 fusion +0) (= left))) (test "Last elements of fused array should equal the second array." (|> (: (Array Nat) - (@;new sizeR)) - (@;copy sizeR sizeL fusion +0) + (@.new sizeR)) + (@.copy sizeR sizeL fusion +0) (= right))) )))) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index 4f1b94478..d2dcd93a1 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -15,114 +15,114 @@ (context: "Dictionaries." (<| (times +100) (do @ - [#let [capped-nat (:: r;Monad<Random> map (n/% +100) r;nat)] + [#let [capped-nat (:: r.Monad<Random> map (n/% +100) r.nat)] size capped-nat - dict (r;dict number;Hash<Nat> size r;nat capped-nat) - non-key (|> r;nat (r;filter (function [key] (not (&;contains? key dict))))) - test-val (|> r;nat (r;filter (function [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))] + dict (r.dict number.Hash<Nat> size r.nat capped-nat) + non-key (|> r.nat (r.filter (function [key] (not (&.contains? key dict))))) + test-val (|> r.nat (r.filter (function [val] (not (list.member? number.Eq<Nat> (&.values dict) val)))))] ($_ seq (test "Size function should correctly represent Dict size." - (n/= size (&;size dict))) + (n/= size (&.size dict))) (test "Dicts of size 0 should be considered empty." (if (n/= +0 size) - (&;empty? dict) - (not (&;empty? dict)))) + (&.empty? dict) + (not (&.empty? dict)))) (test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list;Eq<List> (eq;product number;Eq<Nat> number;Eq<Nat>)) = - (&;entries dict) - (list;zip2 (&;keys dict) - (&;values dict)))) + (:: (list.Eq<List> (eq.product number.Eq<Nat> number.Eq<Nat>)) = + (&.entries dict) + (list.zip2 (&.keys dict) + (&.values dict)))) (test "Dict should be able to recognize it's own keys." - (list;every? (function [key] (&;contains? key dict)) - (&;keys dict))) + (list.every? (function [key] (&.contains? key dict)) + (&.keys dict))) (test "Should be able to get every key." - (list;every? (function [key] (case (&;get key dict) - (#;Some _) true + (list.every? (function [key] (case (&.get key dict) + (#.Some _) true _ false)) - (&;keys dict))) + (&.keys dict))) (test "Shouldn't be able to access non-existant keys." - (case (&;get non-key dict) - (#;Some _) false + (case (&.get non-key dict) + (#.Some _) false _ true)) (test "Should be able to put and then get a value." - (case (&;get non-key (&;put non-key test-val dict)) - (#;Some v) (n/= test-val v) + (case (&.get non-key (&.put non-key test-val dict)) + (#.Some v) (n/= test-val v) _ true)) (test "Should be able to put~ and then get a value." - (case (&;get non-key (&;put~ non-key test-val dict)) - (#;Some v) (n/= test-val v) + (case (&.get non-key (&.put~ non-key test-val dict)) + (#.Some v) (n/= test-val v) _ true)) (test "Shouldn't be able to put~ an existing key." (or (n/= +0 size) - (let [first-key (|> dict &;keys list;head maybe;assume)] - (case (&;get first-key (&;put~ first-key test-val dict)) - (#;Some v) (not (n/= test-val v)) + (let [first-key (|> dict &.keys list.head maybe.assume)] + (case (&.get first-key (&.put~ first-key test-val dict)) + (#.Some v) (not (n/= test-val v)) _ true)))) (test "Removing a key should make it's value inaccessible." - (let [base (&;put non-key test-val dict)] - (and (&;contains? non-key base) - (not (&;contains? non-key (&;remove non-key base)))))) + (let [base (&.put non-key test-val dict)] + (and (&.contains? non-key base) + (not (&.contains? non-key (&.remove non-key base)))))) (test "Should be possible to update values via their keys." - (let [base (&;put non-key test-val dict) - updt (&;update non-key n/inc base)] - (case [(&;get non-key base) (&;get non-key updt)] - [(#;Some x) (#;Some y)] + (let [base (&.put non-key test-val dict) + updt (&.update non-key n/inc base)] + (case [(&.get non-key base) (&.get non-key updt)] + [(#.Some x) (#.Some y)] (n/= (n/inc x) y) _ false))) (test "Additions and removals to a Dict should affect its size." - (let [plus (&;put non-key test-val dict) - base (&;remove non-key plus)] - (and (n/= (n/inc (&;size dict)) (&;size plus)) - (n/= (n/dec (&;size plus)) (&;size base))))) + (let [plus (&.put non-key test-val dict) + base (&.remove non-key plus)] + (and (n/= (n/inc (&.size dict)) (&.size plus)) + (n/= (n/dec (&.size plus)) (&.size base))))) (test "A Dict should equal itself & going to<->from lists shouldn't change that." - (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] + (let [(^open) (&.Eq<Dict> number.Eq<Nat>)] (and (= dict dict) - (|> dict &;entries (&;from-list number;Hash<Nat>) (= dict))))) + (|> dict &.entries (&.from-list number.Hash<Nat>) (= dict))))) (test "Merging a Dict to itself changes nothing." - (let [(^open) (&;Eq<Dict> number;Eq<Nat>)] - (= dict (&;merge dict dict)))) + (let [(^open) (&.Eq<Dict> number.Eq<Nat>)] + (= dict (&.merge dict dict)))) (test "If you merge, and the second dict has overlapping keys, it should overwrite yours." - (let [dict' (|> dict &;entries + (let [dict' (|> dict &.entries (list/map (function [[k v]] [k (n/inc v)])) - (&;from-list number;Hash<Nat>)) - (^open) (&;Eq<Dict> number;Eq<Nat>)] - (= dict' (&;merge dict' dict)))) + (&.from-list number.Hash<Nat>)) + (^open) (&.Eq<Dict> number.Eq<Nat>)] + (= dict' (&.merge dict' dict)))) (test "Can merge values in such a way that they become combined." - (list;every? (function [[x x*2]] (n/= (n/* +2 x) x*2)) - (list;zip2 (&;values dict) - (&;values (&;merge-with n/+ dict dict))))) + (list.every? (function [[x x*2]] (n/= (n/* +2 x) x*2)) + (list.zip2 (&.values dict) + (&.values (&.merge-with n/+ dict dict))))) (test "Should be able to select subset of keys from dict." (|> dict - (&;put non-key test-val) - (&;select (list non-key)) - &;size + (&.put non-key test-val) + (&.select (list non-key)) + &.size (n/= +1))) (test "Should be able to re-bind existing values to different keys." (or (n/= +0 size) - (let [first-key (|> dict &;keys list;head maybe;assume) - rebound (&;re-bind first-key non-key dict)] - (and (n/= (&;size dict) (&;size rebound)) - (&;contains? non-key rebound) - (not (&;contains? first-key rebound)) - (n/= (maybe;assume (&;get first-key dict)) - (maybe;assume (&;get non-key rebound))))))) + (let [first-key (|> dict &.keys list.head maybe.assume) + rebound (&.re-bind first-key non-key dict)] + (and (n/= (&.size dict) (&.size rebound)) + (&.contains? non-key rebound) + (not (&.contains? first-key rebound)) + (n/= (maybe.assume (&.get first-key dict)) + (maybe.assume (&.get non-key rebound))))))) )))) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index 501c2cfc8..281f8b459 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -13,208 +13,208 @@ lux/test) (def: bounded-size - (r;Random Nat) - (|> r;nat - (:: r;Monad<Random> map (|>> (n/% +100) (n/+ +10))))) + (r.Random Nat) + (|> r.nat + (:: r.Monad<Random> map (|>> (n/% +100) (n/+ +10))))) (context: "Lists: Part 1" (<| (times +100) (do @ [size bounded-size - idx (:: @ map (n/% size) r;nat) - sample (r;list size r;nat) + idx (:: @ map (n/% size) r.nat) + sample (r.list size r.nat) other-size bounded-size - other-sample (r;list other-size r;nat) - separator r;nat - #let [(^open) (&;Eq<List> number;Eq<Nat>) - (^open "&/") &;Functor<List>]] + other-sample (r.list other-size r.nat) + separator r.nat + #let [(^open) (&.Eq<List> number.Eq<Nat>) + (^open "&/") &.Functor<List>]] ($_ seq (test "The size function should correctly portray the size of the list." - (n/= size (&;size sample))) + (n/= size (&.size sample))) (test "The repeat function should produce as many elements as asked of it." - (n/= size (&;size (&;repeat size [])))) + (n/= size (&.size (&.repeat size [])))) (test "Reversing a list does not change it's size." - (n/= (&;size sample) - (&;size (&;reverse sample)))) + (n/= (&.size sample) + (&.size (&.reverse sample)))) (test "Reversing a list twice results in the original list." (= sample - (&;reverse (&;reverse sample)))) + (&.reverse (&.reverse sample)))) (test "Filtering by a predicate and its complement should result in a number of elements equal to the original list." - (and (n/= (&;size sample) - (n/+ (&;size (&;filter n/even? sample)) - (&;size (&;filter (bool;complement n/even?) sample)))) - (let [[plus minus] (&;partition n/even? sample)] - (n/= (&;size sample) - (n/+ (&;size plus) - (&;size minus)))))) + (and (n/= (&.size sample) + (n/+ (&.size (&.filter n/even? sample)) + (&.size (&.filter (bool.complement n/even?) sample)))) + (let [[plus minus] (&.partition n/even? sample)] + (n/= (&.size sample) + (n/+ (&.size plus) + (&.size minus)))))) (test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." - (if (&;every? n/even? sample) - (and (not (&;any? (bool;complement n/even?) sample)) - (&;empty? (&;filter (bool;complement n/even?) sample))) - (&;any? (bool;complement n/even?) sample))) + (if (&.every? n/even? sample) + (and (not (&.any? (bool.complement n/even?) sample)) + (&.empty? (&.filter (bool.complement n/even?) sample))) + (&.any? (bool.complement n/even?) sample))) (test "Any element of the list can be considered its member." - (let [elem (maybe;assume (&;nth idx sample))] - (&;member? number;Eq<Nat> sample elem))) + (let [elem (maybe.assume (&.nth idx sample))] + (&.member? number.Eq<Nat> sample elem))) )))) (context: "Lists: Part 2" (<| (times +100) (do @ [size bounded-size - idx (:: @ map (n/% size) r;nat) - sample (r;list size r;nat) + idx (:: @ map (n/% size) r.nat) + sample (r.list size r.nat) other-size bounded-size - other-sample (r;list other-size r;nat) - separator r;nat - #let [(^open) (&;Eq<List> number;Eq<Nat>) - (^open "&/") &;Functor<List>]] + other-sample (r.list other-size r.nat) + separator r.nat + #let [(^open) (&.Eq<List> number.Eq<Nat>) + (^open "&/") &.Functor<List>]] ($_ seq (test "Appending the head and the tail should yield the original list." - (let [head (maybe;assume (&;head sample)) - tail (maybe;assume (&;tail sample))] + (let [head (maybe.assume (&.head sample)) + tail (maybe.assume (&.tail sample))] (= sample - (#;Cons head tail)))) + (#.Cons head tail)))) (test "Appending the inits and the last should yield the original list." - (let [(^open) &;Monoid<List> - inits (maybe;assume (&;inits sample)) - last (maybe;assume (&;last sample))] + (let [(^open) &.Monoid<List> + inits (maybe.assume (&.inits sample)) + last (maybe.assume (&.last sample))] (= sample (compose inits (list last))))) (test "Functor should go over every element of the list." - (let [(^open) &;Functor<List> + (let [(^open) &.Functor<List> there (map n/inc sample) back-again (map n/dec there)] (and (not (= sample there)) (= sample back-again)))) (test "Splitting a list into chunks and re-appending them should yield the original list." - (let [(^open) &;Monoid<List> - [left right] (&;split idx sample) - [left' right'] (&;split-with n/even? sample)] + (let [(^open) &.Monoid<List> + [left right] (&.split idx sample) + [left' right'] (&.split-with n/even? sample)] (and (= sample (compose left right)) (= sample (compose left' right')) (= sample - (compose (&;take idx sample) - (&;drop idx sample))) + (compose (&.take idx sample) + (&.drop idx sample))) (= sample - (compose (&;take-while n/even? sample) - (&;drop-while n/even? sample))) + (compose (&.take-while n/even? sample) + (&.drop-while n/even? sample))) ))) (test "Segmenting the list in pairs should yield as many elements as N/2." (n/= (n// +2 size) - (&;size (&;as-pairs sample)))) + (&.size (&.as-pairs sample)))) (test "Sorting a list shouldn't change it's size." - (n/= (&;size sample) - (&;size (&;sort n/< sample)))) + (n/= (&.size sample) + (&.size (&.sort n/< sample)))) (test "Sorting a list with one order should yield the reverse of sorting it with the opposite order." - (= (&;sort n/< sample) - (&;reverse (&;sort n/> sample)))) + (= (&.sort n/< sample) + (&.reverse (&.sort n/> sample)))) )))) (context: "Lists: Part 3" (<| (times +100) (do @ [size bounded-size - idx (:: @ map (n/% size) r;nat) - sample (r;list size r;nat) + idx (:: @ map (n/% size) r.nat) + sample (r.list size r.nat) other-size bounded-size - other-sample (r;list other-size r;nat) - separator r;nat - #let [(^open) (&;Eq<List> number;Eq<Nat>) - (^open "&/") &;Functor<List>]] + other-sample (r.list other-size r.nat) + separator r.nat + #let [(^open) (&.Eq<List> number.Eq<Nat>) + (^open "&/") &.Functor<List>]] ($_ seq (test "If you zip 2 lists, the result's size will be that of the smaller list." - (n/= (&;size (&;zip2 sample other-sample)) - (n/min (&;size sample) (&;size other-sample)))) + (n/= (&.size (&.zip2 sample other-sample)) + (n/min (&.size sample) (&.size other-sample)))) (test "I can pair-up elements of a list in order." - (let [(^open) &;Functor<List> - zipped (&;zip2 sample other-sample) - num-zipper (&;size zipped)] - (and (|> zipped (map product;left) (= (&;take num-zipper sample))) - (|> zipped (map product;right) (= (&;take num-zipper other-sample)))))) + (let [(^open) &.Functor<List> + zipped (&.zip2 sample other-sample) + num-zipper (&.size zipped)] + (and (|> zipped (map product.left) (= (&.take num-zipper sample))) + (|> zipped (map product.right) (= (&.take num-zipper other-sample)))))) (test "You can generate indices for any size, and they will be in ascending order." - (let [(^open) &;Functor<List> - indices (&;indices size)] - (and (n/= size (&;size indices)) + (let [(^open) &.Functor<List> + indices (&.indices size)] + (and (n/= size (&.size indices)) (= indices - (&;sort n/< indices)) - (&;every? (n/= (n/dec size)) - (&;zip2-with n/+ + (&.sort n/< indices)) + (&.every? (n/= (n/dec size)) + (&.zip2-with n/+ indices - (&;sort n/> indices))) + (&.sort n/> indices))) ))) (test "The 'interpose' function places a value between every member of a list." - (let [(^open) &;Functor<List> - sample+ (&;interpose separator sample)] + (let [(^open) &.Functor<List> + sample+ (&.interpose separator sample)] (and (n/= (|> size (n/* +2) n/dec) - (&;size sample+)) - (|> sample+ &;as-pairs (map product;right) (&;every? (n/= separator)))))) + (&.size sample+)) + (|> sample+ &.as-pairs (map product.right) (&.every? (n/= separator)))))) (test "List append is a monoid." - (let [(^open) &;Monoid<List>] + (let [(^open) &.Monoid<List>] (and (= sample (compose identity sample)) (= sample (compose sample identity)) - (let [[left right] (&;split size (compose sample other-sample))] + (let [[left right] (&.split size (compose sample other-sample))] (and (= sample left) (= other-sample right)))))) (test "Applicative allows you to create singleton lists, and apply lists of functions to lists of values." - (let [(^open) &;Applicative<List>] + (let [(^open) &.Applicative<List>] (and (= (list separator) (wrap separator)) (= (map n/inc sample) (apply (wrap n/inc) sample))))) (test "List concatenation is a monad." - (let [(^open) &;Monad<List> - (^open) &;Monoid<List>] + (let [(^open) &.Monad<List> + (^open) &.Monoid<List>] (= (compose sample other-sample) (join (list sample other-sample))))) (test "You can find any value that satisfies some criterium, if such values exist in the list." - (case (&;find n/even? sample) - (#;Some found) + (case (&.find n/even? sample) + (#.Some found) (and (n/even? found) - (&;any? n/even? sample) - (not (&;every? (bool;complement n/even?) sample))) + (&.any? n/even? sample) + (not (&.every? (bool.complement n/even?) sample))) - #;None - (and (not (&;any? n/even? sample)) - (&;every? (bool;complement n/even?) sample)))) + #.None + (and (not (&.any? n/even? sample)) + (&.every? (bool.complement n/even?) sample)))) (test "You can iteratively construct a list, generating values until you're done." - (= (&;n/range +0 (n/dec size)) - (&;iterate (function [n] (if (n/< size n) (#;Some (n/inc n)) #;None)) + (= (&.n/range +0 (n/dec size)) + (&.iterate (function [n] (if (n/< size n) (#.Some (n/inc n)) #.None)) +0))) (test "Can enumerate all elements in a list." - (let [enum-sample (&;enumerate sample)] - (and (= (&;indices (&;size enum-sample)) - (&/map product;left enum-sample)) + (let [enum-sample (&.enumerate sample)] + (and (= (&.indices (&.size enum-sample)) + (&/map product.left enum-sample)) (= sample - (&/map product;right enum-sample))))) + (&/map product.right enum-sample))))) )))) (context: "Monad transformer" - (let [lift (&;lift io;Monad<IO>) - (^open "io/") io;Monad<IO>] + (let [lift (&.lift io.Monad<IO>) + (^open "io/") io.Monad<IO>] (test "Can add list functionality to any monad." - (|> (io;run (do (&;ListT io;Monad<IO>) + (|> (io.run (do (&.ListT io.Monad<IO>) [a (lift (io/wrap 123)) b (wrap 456)] (wrap (i/+ a b)))) diff --git a/stdlib/test/test/lux/data/coll/ordered/dict.lux b/stdlib/test/test/lux/data/coll/ordered/dict.lux index b3a6d6f58..dc4adca7c 100644 --- a/stdlib/test/test/lux/data/coll/ordered/dict.lux +++ b/stdlib/test/test/lux/data/coll/ordered/dict.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -15,40 +15,40 @@ (context: "Dict" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (n/% +100))) - keys (r;set number;Hash<Nat> size r;nat) - values (r;set number;Hash<Nat> size r;nat) - extra-key (|> r;nat (r;filter (|>> (s;member? keys) not))) - extra-value r;nat - #let [pairs (list;zip2 (s;to-list keys) - (s;to-list values)) - sample (&;from-list number;Order<Nat> pairs) - sorted-pairs (list;sort (function [[left _] [right _]] + [size (|> r.nat (:: @ map (n/% +100))) + keys (r.set number.Hash<Nat> size r.nat) + values (r.set number.Hash<Nat> size r.nat) + extra-key (|> r.nat (r.filter (|>> (s.member? keys) not))) + extra-value r.nat + #let [pairs (list.zip2 (s.to-list keys) + (s.to-list values)) + sample (&.from-list number.Order<Nat> pairs) + sorted-pairs (list.sort (function [[left _] [right _]] (n/< left right)) pairs) - sorted-values (L/map product;right sorted-pairs) - (^open "&/") (&;Eq<Dict> number;Eq<Nat>)]] + sorted-values (L/map product.right sorted-pairs) + (^open "&/") (&.Eq<Dict> number.Eq<Nat>)]] ($_ seq (test "Can query the size of a dictionary." - (n/= size (&;size sample))) + (n/= size (&.size sample))) (test "Can query value for minimum key." - (case [(&;min sample) (list;head sorted-values)] - [#;None #;None] + (case [(&.min sample) (list.head sorted-values)] + [#.None #.None] true - [(#;Some reference) (#;Some sample)] + [(#.Some reference) (#.Some sample)] (n/= reference sample) _ false)) (test "Can query value for maximum key." - (case [(&;max sample) (list;last sorted-values)] - [#;None #;None] + (case [(&.max sample) (list.last sorted-values)] + [#.None #.None] true - [(#;Some reference) (#;Some sample)] + [(#.Some reference) (#.Some sample)] (n/= reference sample) _ @@ -56,30 +56,30 @@ (test "Converting dictionaries to/from lists cannot change their values." (|> sample - &;entries (&;from-list number;Order<Nat>) + &.entries (&.from-list number.Order<Nat>) (&/= sample))) (test "Order is preserved." - (let [(^open "L/") (list;Eq<List> (: (Eq [Nat Nat]) + (let [(^open "L/") (list.Eq<List> (: (Eq [Nat Nat]) (function [[kr vr] [ks vs]] (and (n/= kr ks) (n/= vr vs)))))] - (L/= (&;entries sample) + (L/= (&.entries sample) sorted-pairs))) (test "Every key in a dictionary must be identifiable." - (list;every? (function [key] (&;contains? key sample)) - (&;keys sample))) + (list.every? (function [key] (&.contains? key sample)) + (&.keys sample))) (test "Can add and remove elements in a dictionary." - (and (not (&;contains? extra-key sample)) - (let [sample' (&;put extra-key extra-value sample) - sample'' (&;remove extra-key sample')] - (and (&;contains? extra-key sample') - (not (&;contains? extra-key sample'')) - (case [(&;get extra-key sample') - (&;get extra-key sample'')] - [(#;Some found) #;None] + (and (not (&.contains? extra-key sample)) + (let [sample' (&.put extra-key extra-value sample) + sample'' (&.remove extra-key sample')] + (and (&.contains? extra-key sample') + (not (&.contains? extra-key sample'')) + (case [(&.get extra-key sample') + (&.get extra-key sample'')] + [(#.Some found) #.None] (n/= extra-value found) _ diff --git a/stdlib/test/test/lux/data/coll/ordered/set.lux b/stdlib/test/test/lux/data/coll/ordered/set.lux index 87c720597..123613972 100644 --- a/stdlib/test/test/lux/data/coll/ordered/set.lux +++ b/stdlib/test/test/lux/data/coll/ordered/set.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -11,44 +11,44 @@ lux/test) (def: gen-nat - (r;Random Nat) - (|> r;nat - (:: r;Monad<Random> map (n/% +100)))) + (r.Random Nat) + (|> r.nat + (:: r.Monad<Random> map (n/% +100)))) (context: "Sets" (<| (times +100) (do @ [sizeL gen-nat sizeR gen-nat - listL (|> (r;set number;Hash<Nat> sizeL gen-nat) (:: @ map s;to-list)) - listR (|> (r;set number;Hash<Nat> sizeR gen-nat) (:: @ map s;to-list)) - #let [(^open "&/") &;Eq<Set> - setL (&;from-list number;Order<Nat> listL) - setR (&;from-list number;Order<Nat> listR) - sortedL (list;sort n/< listL) - minL (list;head sortedL) - maxL (list;last sortedL)]] + listL (|> (r.set number.Hash<Nat> sizeL gen-nat) (:: @ map s.to-list)) + listR (|> (r.set number.Hash<Nat> sizeR gen-nat) (:: @ map s.to-list)) + #let [(^open "&/") &.Eq<Set> + setL (&.from-list number.Order<Nat> listL) + setR (&.from-list number.Order<Nat> listR) + sortedL (list.sort n/< listL) + minL (list.head sortedL) + maxL (list.last sortedL)]] ($_ seq (test "I can query the size of a set." - (n/= sizeL (&;size setL))) + (n/= sizeL (&.size setL))) (test "Can query minimum value." - (case [(&;min setL) minL] - [#;None #;None] + (case [(&.min setL) minL] + [#.None #.None] true - [(#;Some reference) (#;Some sample)] + [(#.Some reference) (#.Some sample)] (n/= reference sample) _ false)) (test "Can query maximum value." - (case [(&;max setL) maxL] - [#;None #;None] + (case [(&.max setL) maxL] + [#.None #.None] true - [(#;Some reference) (#;Some sample)] + [(#.Some reference) (#.Some sample)] (n/= reference sample) _ @@ -56,39 +56,39 @@ (test "Converting sets to/from lists can't change their values." (|> setL - &;to-list (&;from-list number;Order<Nat>) + &.to-list (&.from-list number.Order<Nat>) (&/= setL))) (test "Order is preserved." - (let [listL (&;to-list setL) - (^open "L/") (list;Eq<List> number;Eq<Nat>)] + (let [listL (&.to-list setL) + (^open "L/") (list.Eq<List> number.Eq<Nat>)] (L/= listL - (list;sort n/< listL)))) + (list.sort n/< listL)))) (test "Every set is a sub-set of the union of itself with another." - (let [setLR (&;union setL setR)] - (and (&;sub? setLR setL) - (&;sub? setLR setR)))) + (let [setLR (&.union setL setR)] + (and (&.sub? setLR setL) + (&.sub? setLR setR)))) (test "Every set is a super-set of the intersection of itself with another." - (let [setLR (&;intersection setL setR)] - (and (&;super? setLR setL) - (&;super? setLR setR)))) + (let [setLR (&.intersection setL setR)] + (and (&.super? setLR setL) + (&.super? setLR setR)))) (test "Union with the empty set leaves a set unchanged." (&/= setL - (&;union (&;new number;Order<Nat>) + (&.union (&.new number.Order<Nat>) setL))) (test "Intersection with the empty set results in the empty set." - (let [empty-set (&;new number;Order<Nat>)] + (let [empty-set (&.new number.Order<Nat>)] (&/= empty-set - (&;intersection empty-set setL)))) + (&.intersection empty-set setL)))) (test "After substracting a set A from another B, no member of A can be a member of B." - (let [sub (&;difference setR setL)] - (not (list;any? (&;member? sub) (&;to-list setR))))) + (let [sub (&.difference setR setL)] + (not (list.any? (&.member? sub) (&.to-list setR))))) (test "Every member of a set must be identifiable." - (list;every? (&;member? setL) (&;to-list setL))) + (list.every? (&.member? setL) (&.to-list setL))) )))) diff --git a/stdlib/test/test/lux/data/coll/priority-queue.lux b/stdlib/test/test/lux/data/coll/priority-queue.lux index 8b94d0612..6c7fac180 100644 --- a/stdlib/test/test/lux/data/coll/priority-queue.lux +++ b/stdlib/test/test/lux/data/coll/priority-queue.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -9,44 +9,44 @@ lux/test) (def: (gen-queue size) - (-> Nat (r;Random (&;Queue Nat))) - (do r;Monad<Random> - [inputs (r;list size r;nat)] - (monad;fold @ (function [head tail] + (-> Nat (r.Random (&.Queue Nat))) + (do r.Monad<Random> + [inputs (r.list size r.nat)] + (monad.fold @ (function [head tail] (do @ - [priority r;nat] - (wrap (&;push priority head tail)))) - &;empty + [priority r.nat] + (wrap (&.push priority head tail)))) + &.empty inputs))) (context: "Queues" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (n/% +100))) + [size (|> r.nat (:: @ map (n/% +100))) sample (gen-queue size) - non-member-priority r;nat - non-member (|> r;nat (r;filter (|>> (&;member? number;Eq<Nat> sample) not)))] + non-member-priority r.nat + non-member (|> r.nat (r.filter (|>> (&.member? number.Eq<Nat> sample) not)))] ($_ seq (test "I can query the size of a queue (and empty queues have size 0)." - (n/= size (&;size sample))) + (n/= size (&.size sample))) (test "Enqueueing and dequeing affects the size of queues." (and (n/= (n/inc size) - (&;size (&;push non-member-priority non-member sample))) - (or (n/= +0 (&;size sample)) + (&.size (&.push non-member-priority non-member sample))) + (or (n/= +0 (&.size sample)) (n/= (n/dec size) - (&;size (&;pop sample)))))) + (&.size (&.pop sample)))))) (test "I can query whether an element belongs to a queue." - (and (and (not (&;member? number;Eq<Nat> sample non-member)) - (&;member? number;Eq<Nat> - (&;push non-member-priority non-member sample) + (and (and (not (&.member? number.Eq<Nat> sample non-member)) + (&.member? number.Eq<Nat> + (&.push non-member-priority non-member sample) non-member)) - (or (n/= +0 (&;size sample)) - (and (&;member? number;Eq<Nat> + (or (n/= +0 (&.size sample)) + (and (&.member? number.Eq<Nat> sample - (maybe;assume (&;peek sample))) - (not (&;member? number;Eq<Nat> - (&;pop sample) - (maybe;assume (&;peek sample)))))))) + (maybe.assume (&.peek sample))) + (not (&.member? number.Eq<Nat> + (&.pop sample) + (maybe.assume (&.peek sample)))))))) )))) diff --git a/stdlib/test/test/lux/data/coll/queue.lux b/stdlib/test/test/lux/data/coll/queue.lux index 4e9d00093..34330838b 100644 --- a/stdlib/test/test/lux/data/coll/queue.lux +++ b/stdlib/test/test/lux/data/coll/queue.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -10,42 +10,42 @@ (context: "Queues" (<| (times +100) (do @ - [size (:: @ map (n/% +100) r;nat) - sample (r;queue size r;nat) - non-member (|> r;nat - (r;filter (|>> (&;member? number;Eq<Nat> sample) not)))] + [size (:: @ map (n/% +100) r.nat) + sample (r.queue size r.nat) + non-member (|> r.nat + (r.filter (|>> (&.member? number.Eq<Nat> sample) not)))] ($_ seq (test "I can query the size of a queue (and empty queues have size 0)." (if (n/= +0 size) - (&;empty? sample) - (n/= size (&;size sample)))) + (&.empty? sample) + (n/= size (&.size sample)))) (test "Enqueueing and dequeing affects the size of queues." - (and (n/= (n/inc size) (&;size (&;push non-member sample))) - (or (&;empty? sample) - (n/= (n/dec size) (&;size (&;pop sample)))) - (n/= size (&;size (&;pop (&;push non-member sample)))))) + (and (n/= (n/inc size) (&.size (&.push non-member sample))) + (or (&.empty? sample) + (n/= (n/dec size) (&.size (&.pop sample)))) + (n/= size (&.size (&.pop (&.push non-member sample)))))) (test "Transforming to/from list can't change the queue." - (let [(^open "&/") (&;Eq<Queue> number;Eq<Nat>)] + (let [(^open "&/") (&.Eq<Queue> number.Eq<Nat>)] (|> sample - &;to-list &;from-list + &.to-list &.from-list (&/= sample)))) (test "I can always peek at a non-empty queue." - (case (&;peek sample) - #;None (&;empty? sample) - (#;Some _) true)) + (case (&.peek sample) + #.None (&.empty? sample) + (#.Some _) true)) (test "I can query whether an element belongs to a queue." - (and (not (&;member? number;Eq<Nat> sample non-member)) - (&;member? number;Eq<Nat> (&;push non-member sample) + (and (not (&.member? number.Eq<Nat> sample non-member)) + (&.member? number.Eq<Nat> (&.push non-member sample) non-member) - (case (&;peek sample) - #;None - (&;empty? sample) + (case (&.peek sample) + #.None + (&.empty? sample) - (#;Some first) - (and (&;member? number;Eq<Nat> sample first) - (not (&;member? number;Eq<Nat> (&;pop sample) first)))))) + (#.Some first) + (and (&.member? number.Eq<Nat> sample first) + (not (&.member? number.Eq<Nat> (&.pop sample) first)))))) )))) diff --git a/stdlib/test/test/lux/data/coll/sequence.lux b/stdlib/test/test/lux/data/coll/sequence.lux index 28660cc6f..145493c3e 100644 --- a/stdlib/test/test/lux/data/coll/sequence.lux +++ b/stdlib/test/test/lux/data/coll/sequence.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -12,48 +12,48 @@ (context: "Sequences" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) - idx (|> r;nat (:: @ map (n/% size))) - sample (r;sequence size r;nat) - other-sample (r;sequence size r;nat) - non-member (|> r;nat (r;filter (|>> (&;member? number;Eq<Nat> sample) not))) - #let [(^open "&/") (&;Eq<Sequence> number;Eq<Nat>) - (^open "&/") &;Monad<Sequence> - (^open "&/") &;Fold<Sequence> - (^open "&/") &;Monoid<Sequence>]] + [size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +1)))) + idx (|> r.nat (:: @ map (n/% size))) + sample (r.sequence size r.nat) + other-sample (r.sequence size r.nat) + non-member (|> r.nat (r.filter (|>> (&.member? number.Eq<Nat> sample) not))) + #let [(^open "&/") (&.Eq<Sequence> number.Eq<Nat>) + (^open "&/") &.Monad<Sequence> + (^open "&/") &.Fold<Sequence> + (^open "&/") &.Monoid<Sequence>]] ($_ seq (test "Can query size of sequence." - (if (&;empty? sample) + (if (&.empty? sample) (and (n/= +0 size) - (n/= +0 (&;size sample))) - (n/= size (&;size sample)))) + (n/= +0 (&.size sample))) + (n/= size (&.size sample)))) (test "Can add and remove elements to sequences." - (and (n/= (n/inc size) (&;size (&;add non-member sample))) - (n/= (n/dec size) (&;size (&;pop sample))))) + (and (n/= (n/inc size) (&.size (&.add non-member sample))) + (n/= (n/dec size) (&.size (&.pop sample))))) (test "Can put and get elements into sequences." (|> sample - (&;put idx non-member) - (&;nth idx) - maybe;assume + (&.put idx non-member) + (&.nth idx) + maybe.assume (is non-member))) (test "Can update elements of sequences." (|> sample - (&;put idx non-member) (&;update idx n/inc) - (&;nth idx) maybe;assume + (&.put idx non-member) (&.update idx n/inc) + (&.nth idx) maybe.assume (n/= (n/inc non-member)))) (test "Can safely transform to/from lists." - (|> sample &;to-list &;from-list (&/= sample))) + (|> sample &.to-list &.from-list (&/= sample))) (test "Can identify members of a sequence." - (and (not (&;member? number;Eq<Nat> sample non-member)) - (&;member? number;Eq<Nat> (&;add non-member sample) non-member))) + (and (not (&.member? number.Eq<Nat> sample non-member)) + (&.member? number.Eq<Nat> (&.add non-member sample) non-member))) (test "Can fold over elements of sequence." - (n/= (list/fold n/+ +0 (&;to-list sample)) + (n/= (list/fold n/+ +0 (&.to-list sample)) (&/fold n/+ +0 sample))) (test "Functor goes over every element." @@ -63,10 +63,10 @@ (&/= sample back-again)))) (test "Applicative allows you to create singleton sequences, and apply sequences of functions to sequences of values." - (and (&/= (&;sequence non-member) (&/wrap non-member)) + (and (&/= (&.sequence non-member) (&/wrap non-member)) (&/= (&/map n/inc sample) (&/apply (&/wrap n/inc) sample)))) (test "Sequence concatenation is a monad." (&/= (&/compose sample other-sample) - (&/join (&;sequence sample other-sample)))) + (&/join (&.sequence sample other-sample)))) )))) diff --git a/stdlib/test/test/lux/data/coll/set.lux b/stdlib/test/test/lux/data/coll/set.lux index e4a0b2ad1..eb43bd0d2 100644 --- a/stdlib/test/test/lux/data/coll/set.lux +++ b/stdlib/test/test/lux/data/coll/set.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -9,56 +9,56 @@ lux/test) (def: gen-nat - (r;Random Nat) - (|> r;nat - (:: r;Monad<Random> map (n/% +100)))) + (r.Random Nat) + (|> r.nat + (:: r.Monad<Random> map (n/% +100)))) (context: "Sets" (<| (times +100) (do @ [sizeL gen-nat sizeR gen-nat - setL (r;set number;Hash<Nat> sizeL gen-nat) - setR (r;set number;Hash<Nat> sizeR gen-nat) + setL (r.set number.Hash<Nat> sizeL gen-nat) + setR (r.set number.Hash<Nat> sizeR gen-nat) non-member (|> gen-nat - (r;filter (|>> (&;member? setL) not))) - #let [(^open "&/") &;Eq<Set>]] + (r.filter (|>> (&.member? setL) not))) + #let [(^open "&/") &.Eq<Set>]] ($_ seq (test "I can query the size of a set." - (and (n/= sizeL (&;size setL)) - (n/= sizeR (&;size setR)))) + (and (n/= sizeL (&.size setL)) + (n/= sizeR (&.size setR)))) (test "Converting sets to/from lists can't change their values." (|> setL - &;to-list (&;from-list number;Hash<Nat>) + &.to-list (&.from-list number.Hash<Nat>) (&/= setL))) (test "Every set is a sub-set of the union of itself with another." - (let [setLR (&;union setL setR)] - (and (&;sub? setLR setL) - (&;sub? setLR setR)))) + (let [setLR (&.union setL setR)] + (and (&.sub? setLR setL) + (&.sub? setLR setR)))) (test "Every set is a super-set of the intersection of itself with another." - (let [setLR (&;intersection setL setR)] - (and (&;super? setLR setL) - (&;super? setLR setR)))) + (let [setLR (&.intersection setL setR)] + (and (&.super? setLR setL) + (&.super? setLR setR)))) (test "Union with the empty set leaves a set unchanged." (&/= setL - (&;union (&;new number;Hash<Nat>) + (&.union (&.new number.Hash<Nat>) setL))) (test "Intersection with the empty set results in the empty set." - (let [empty-set (&;new number;Hash<Nat>)] + (let [empty-set (&.new number.Hash<Nat>)] (&/= empty-set - (&;intersection empty-set setL)))) + (&.intersection empty-set setL)))) (test "After substracting a set A from another B, no member of A can be a member of B." - (let [sub (&;difference setR setL)] - (not (list;any? (&;member? sub) (&;to-list setR))))) + (let [sub (&.difference setR setL)] + (not (list.any? (&.member? sub) (&.to-list setR))))) (test "Every member of a set must be identifiable." - (and (not (&;member? setL non-member)) - (&;member? (&;add non-member setL) non-member) - (not (&;member? (&;remove non-member (&;add non-member setL)) non-member)))) + (and (not (&.member? setL non-member)) + (&.member? (&.add non-member setL) non-member) + (not (&.member? (&.remove non-member (&.add non-member setL)) non-member)))) )))) diff --git a/stdlib/test/test/lux/data/coll/stack.lux b/stdlib/test/test/lux/data/coll/stack.lux index d9e365d61..2cbd2a1ab 100644 --- a/stdlib/test/test/lux/data/coll/stack.lux +++ b/stdlib/test/test/lux/data/coll/stack.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -10,36 +10,36 @@ lux/test) (def: gen-nat - (r;Random Nat) - (|> r;nat - (:: r;Monad<Random> map (n/% +100)))) + (r.Random Nat) + (|> r.nat + (:: r.Monad<Random> map (n/% +100)))) (context: "Stacks" (<| (times +100) (do @ [size gen-nat - sample (r;stack size gen-nat) + sample (r.stack size gen-nat) new-top gen-nat] ($_ seq (test "Can query the size of a stack." - (n/= size (&;size sample))) + (n/= size (&.size sample))) (test "Can peek inside non-empty stacks." - (case (&;peek sample) - #;None (&;empty? sample) - (#;Some _) (not (&;empty? sample)))) + (case (&.peek sample) + #.None (&.empty? sample) + (#.Some _) (not (&.empty? sample)))) (test "Popping empty stacks doesn't change anything. But, if they're non-empty, the top of the stack is removed." - (let [sample' (&;pop sample)] - (or (n/= (&;size sample) (n/inc (&;size sample'))) - (and (&;empty? sample) (&;empty? sample'))) + (let [sample' (&.pop sample)] + (or (n/= (&.size sample) (n/inc (&.size sample'))) + (and (&.empty? sample) (&.empty? sample'))) )) (test "Pushing onto a stack always increases it by 1, adding a new value at the top." (and (is sample - (&;pop (&;push new-top sample))) - (n/= (n/inc (&;size sample)) (&;size (&;push new-top sample))) - (|> (&;push new-top sample) &;peek maybe;assume + (&.pop (&.push new-top sample))) + (n/= (n/inc (&.size sample)) (&.size (&.push new-top sample))) + (|> (&.push new-top sample) &.peek maybe.assume (is new-top)))) )))) diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux index 725426f1b..f7beb55bf 100644 --- a/stdlib/test/test/lux/data/coll/stream.lux +++ b/stdlib/test/test/lux/data/coll/stream.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -16,87 +16,87 @@ (context: "Streams" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +2)))) - offset (|> r;nat (:: @ map (n/% +100))) - factor (|> r;nat (:: @ map (|>> (n/% +100) (n/max +2)))) - elem r;nat - cycle-seed (r;list size r;nat) - cycle-sample-idx (|> r;nat (:: @ map (n/% +1000))) - #let [(^open "List/") (list;Eq<List> number;Eq<Nat>) - sample0 (&;iterate n/inc +0) - sample1 (&;iterate n/inc offset)]] + [size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2)))) + offset (|> r.nat (:: @ map (n/% +100))) + factor (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2)))) + elem r.nat + cycle-seed (r.list size r.nat) + cycle-sample-idx (|> r.nat (:: @ map (n/% +1000))) + #let [(^open "List/") (list.Eq<List> number.Eq<Nat>) + sample0 (&.iterate n/inc +0) + sample1 (&.iterate n/inc offset)]] ($_ seq (test "Can move along a stream and take slices off it." - (and (and (List/= (list;n/range +0 (n/dec size)) - (&;take size sample0)) - (List/= (list;n/range offset (n/dec (n/+ offset size))) - (&;take size (&;drop offset sample0))) - (let [[drops takes...] (&;split size sample0)] - (and (List/= (list;n/range +0 (n/dec size)) + (and (and (List/= (list.n/range +0 (n/dec size)) + (&.take size sample0)) + (List/= (list.n/range offset (n/dec (n/+ offset size))) + (&.take size (&.drop offset sample0))) + (let [[drops takes] (&.split size sample0)] + (and (List/= (list.n/range +0 (n/dec size)) drops) - (List/= (list;n/range size (n/dec (n/* +2 size))) - (&;take size takes...))))) - (and (List/= (list;n/range +0 (n/dec size)) - (&;take-while (n/< size) sample0)) - (List/= (list;n/range offset (n/dec (n/+ offset size))) - (&;take-while (n/< (n/+ offset size)) - (&;drop-while (n/< offset) sample0))) - (let [[drops takes...] (&;split-while (n/< size) sample0)] - (and (List/= (list;n/range +0 (n/dec size)) + (List/= (list.n/range size (n/dec (n/* +2 size))) + (&.take size takes))))) + (and (List/= (list.n/range +0 (n/dec size)) + (&.take-while (n/< size) sample0)) + (List/= (list.n/range offset (n/dec (n/+ offset size))) + (&.take-while (n/< (n/+ offset size)) + (&.drop-while (n/< offset) sample0))) + (let [[drops takes] (&.split-while (n/< size) sample0)] + (and (List/= (list.n/range +0 (n/dec size)) drops) - (List/= (list;n/range size (n/dec (n/* +2 size))) - (&;take-while (n/< (n/* +2 size)) takes...))))) + (List/= (list.n/range size (n/dec (n/* +2 size))) + (&.take-while (n/< (n/* +2 size)) takes))))) )) (test "Can repeat any element and infinite number of times." - (n/= elem (&;nth offset (&;repeat elem)))) + (n/= elem (&.nth offset (&.repeat elem)))) (test "Can obtain the head & tail of a stream." - (and (n/= offset (&;head sample1)) - (List/= (list;n/range (n/inc offset) (n/+ offset size)) - (&;take size (&;tail sample1))))) + (and (n/= offset (&.head sample1)) + (List/= (list.n/range (n/inc offset) (n/+ offset size)) + (&.take size (&.tail sample1))))) (test "Can filter streams." (and (n/= (n/* +2 offset) - (&;nth offset - (&;filter n/even? sample0))) - (let [[evens odds] (&;partition n/even? (&;iterate n/inc +0))] + (&.nth offset + (&.filter n/even? sample0))) + (let [[evens odds] (&.partition n/even? (&.iterate n/inc +0))] (and (n/= (n/* +2 offset) - (&;nth offset evens)) + (&.nth offset evens)) (n/= (n/inc (n/* +2 offset)) - (&;nth offset odds)))))) + (&.nth offset odds)))))) (test "Functor goes over 'all' elements in a stream." - (let [(^open "&/") &;Functor<Stream> + (let [(^open "&/") &.Functor<Stream> there (&/map (n/* factor) sample0) back-again (&/map (n// factor) there)] - (and (not (List/= (&;take size sample0) - (&;take size there))) - (List/= (&;take size sample0) - (&;take size back-again))))) + (and (not (List/= (&.take size sample0) + (&.take size there))) + (List/= (&.take size sample0) + (&.take size back-again))))) (test "CoMonad produces a value for every element in a stream." - (let [(^open "&/") &;Functor<Stream>] - (List/= (&;take size (&/map (n/* factor) sample1)) - (&;take size - (be &;CoMonad<Stream> + (let [(^open "&/") &.Functor<Stream>] + (List/= (&.take size (&/map (n/* factor) sample1)) + (&.take size + (be &.CoMonad<Stream> [inputs sample1] - (n/* factor (&;head inputs))))))) + (n/* factor (&.head inputs))))))) (test "'unfold' generalizes 'iterate'." - (let [(^open "&/") &;Functor<Stream> - (^open "List/") (list;Eq<List> text;Eq<Text>)] - (List/= (&;take size - (&/map Nat/encode (&;iterate n/inc offset))) - (&;take size - (&;unfold (function [n] [(n/inc n) (Nat/encode n)]) + (let [(^open "&/") &.Functor<Stream> + (^open "List/") (list.Eq<List> text.Eq<Text>)] + (List/= (&.take size + (&/map Nat/encode (&.iterate n/inc offset))) + (&.take size + (&.unfold (function [n] [(n/inc n) (Nat/encode n)]) offset))))) (test "Can cycle over the same elements as an infinite stream." - (|> (&;cycle cycle-seed) - maybe;assume - (&;nth cycle-sample-idx) + (|> (&.cycle cycle-seed) + maybe.assume + (&.nth cycle-sample-idx) (n/= (|> cycle-seed - (list;nth (n/% size cycle-sample-idx)) - maybe;assume)))) + (list.nth (n/% size cycle-sample-idx)) + maybe.assume)))) )))) diff --git a/stdlib/test/test/lux/data/coll/tree/rose.lux b/stdlib/test/test/lux/data/coll/tree/rose.lux index 9fe725f9b..4ff1c9ea3 100644 --- a/stdlib/test/test/lux/data/coll/tree/rose.lux +++ b/stdlib/test/test/lux/data/coll/tree/rose.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -12,26 +12,26 @@ lux/test) (def: gen-tree - (r;Random [Nat (&;Tree Nat)]) - (r;rec + (r.Random [Nat (&.Tree Nat)]) + (r.rec (function [gen-tree] - (r;either (:: r;Monad<Random> map (|>> &;leaf [+1]) r;nat) - (do r;Monad<Random> - [value r;nat - num-children (|> r;nat (:: @ map (n/% +3))) - children' (r;list num-children gen-tree) - #let [size' (L/fold n/+ +0 (L/map product;left children')) - children (L/map product;right children')]] + (r.either (:: r.Monad<Random> map (|>> &.leaf [+1]) r.nat) + (do r.Monad<Random> + [value r.nat + num-children (|> r.nat (:: @ map (n/% +3))) + children' (r.list num-children gen-tree) + #let [size' (L/fold n/+ +0 (L/map product.left children')) + children (L/map product.right children')]] (wrap [(n/inc size') - (&;branch value children)])) + (&.branch value children)])) )))) (context: "Trees" (<| (times +100) (do @ [[size sample] gen-tree - #let [(^open "&/") (&;Eq<Tree> number;Eq<Nat>) - (^open "&/") &;Fold<Tree> + #let [(^open "&/") (&.Eq<Tree> number.Eq<Nat>) + (^open "&/") &.Fold<Tree> concat (function [addition partial] (format partial (%n addition)))]] ($_ seq (test "Can compare trees for equality." @@ -39,9 +39,9 @@ (test "Can flatten a tree to get all the nodes as a flat tree." (n/= size - (list;size (&;flatten sample)))) + (list.size (&.flatten sample)))) (test "Can fold trees." (T/= (&/fold concat "" sample) - (L/fold concat "" (&;flatten sample)))) + (L/fold concat "" (&.flatten sample)))) )))) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index f184090db..1347ee7bd 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -14,111 +14,111 @@ lux/test) (def: gen-tree - (r;Random (rose;Tree Nat)) - (r;rec (function [gen-tree] - (do r;Monad<Random> + (r.Random (rose.Tree Nat)) + (r.rec (function [gen-tree] + (do r.Monad<Random> ## Each branch can have, at most, 1 child. - [size (|> r;nat (:: @ map (n/% +2)))] - (r;seq r;nat - (r;list size gen-tree)))))) + [size (|> r.nat (:: @ map (n/% +2)))] + (r.seq r.nat + (r.list size gen-tree)))))) (def: (to-end zipper) - (All [a] (-> (&;Zipper a) (&;Zipper a))) + (All [a] (-> (&.Zipper a) (&.Zipper a))) (loop [zipper zipper] - (if (&;end? zipper) + (if (&.end? zipper) zipper - (recur (&;next zipper))))) + (recur (&.next zipper))))) (context: "Zippers." (<| (times +100) (do @ [sample gen-tree - new-val r;nat - pre-val r;nat - post-val r;nat - #let [(^open "tree/") (rose;Eq<Tree> number;Eq<Nat>) - (^open "L/") (list;Eq<List> number;Eq<Nat>)]] + new-val r.nat + pre-val r.nat + post-val r.nat + #let [(^open "tree/") (rose.Eq<Tree> number.Eq<Nat>) + (^open "L/") (list.Eq<List> number.Eq<Nat>)]] ($_ seq (test "Trees can be converted to/from zippers." (|> sample - &;zip &;unzip + &.zip &.unzip (tree/= sample))) (test "Creating a zipper gives you a root node." - (|> sample &;zip &;root?)) + (|> sample &.zip &.root?)) (test "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&;zip sample)] - (if (&;branch? zipper) - (let [child (|> zipper &;down)] - (and (not (tree/= sample (&;unzip child))) - (|> child &;up (is zipper) not) - (|> child &;root (is zipper) not))) - (and (&;leaf? zipper) - (|> zipper (&;prepend-child new-val) &;branch?))))) + (let [zipper (&.zip sample)] + (if (&.branch? zipper) + (let [child (|> zipper &.down)] + (and (not (tree/= sample (&.unzip child))) + (|> child &.up (is zipper) not) + (|> child &.root (is zipper) not))) + (and (&.leaf? zipper) + (|> zipper (&.prepend-child new-val) &.branch?))))) (test "Can prepend and append children." - (let [zipper (&;zip sample)] - (if (&;branch? zipper) - (let [mid-val (|> zipper &;down &;value) + (let [zipper (&.zip sample)] + (if (&.branch? zipper) + (let [mid-val (|> zipper &.down &.value) zipper (|> zipper - (&;prepend-child pre-val) - (&;append-child post-val))] - (and (|> zipper &;down &;value (is pre-val)) - (|> zipper &;down &;right &;value (is mid-val)) - (|> zipper &;down &;right &;right &;value (is post-val)) - (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val)) - (|> zipper &;down &;right &;left &;value (is pre-val)) - (|> zipper &;down &;rightmost &;value (is post-val)))) + (&.prepend-child pre-val) + (&.append-child post-val))] + (and (|> zipper &.down &.value (is pre-val)) + (|> zipper &.down &.right &.value (is mid-val)) + (|> zipper &.down &.right &.right &.value (is post-val)) + (|> zipper &.down &.rightmost &.leftmost &.value (is pre-val)) + (|> zipper &.down &.right &.left &.value (is pre-val)) + (|> zipper &.down &.rightmost &.value (is post-val)))) true))) (test "Can insert children around a node (unless it's root)." - (let [zipper (&;zip sample)] - (if (&;branch? zipper) - (let [mid-val (|> zipper &;down &;value) + (let [zipper (&.zip sample)] + (if (&.branch? zipper) + (let [mid-val (|> zipper &.down &.value) zipper (|> zipper - &;down - (&;insert-left pre-val) - maybe;assume - (&;insert-right post-val) - maybe;assume - &;up)] - (and (|> zipper &;down &;value (is pre-val)) - (|> zipper &;down &;right &;value (is mid-val)) - (|> zipper &;down &;right &;right &;value (is post-val)) - (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val)) - (|> zipper &;down &;right &;left &;value (is pre-val)) - (|> zipper &;down &;rightmost &;value (is post-val)))) - (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false - #;None true)) - (|> zipper (&;insert-right post-val) (case> (#;Some _) false - #;None true)))))) + &.down + (&.insert-left pre-val) + maybe.assume + (&.insert-right post-val) + maybe.assume + &.up)] + (and (|> zipper &.down &.value (is pre-val)) + (|> zipper &.down &.right &.value (is mid-val)) + (|> zipper &.down &.right &.right &.value (is post-val)) + (|> zipper &.down &.rightmost &.leftmost &.value (is pre-val)) + (|> zipper &.down &.right &.left &.value (is pre-val)) + (|> zipper &.down &.rightmost &.value (is post-val)))) + (and (|> zipper (&.insert-left pre-val) (case> (#.Some _) false + #.None true)) + (|> zipper (&.insert-right post-val) (case> (#.Some _) false + #.None true)))))) (test "Can set and update the value of a node." - (|> sample &;zip (&;set new-val) &;value (n/= new-val))) + (|> sample &.zip (&.set new-val) &.value (n/= new-val))) (test "Zipper traversal follows the outline of the tree depth-first." - (L/= (rose;flatten sample) - (loop [zipper (&;zip sample)] - (if (&;end? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;next zipper))))))) + (L/= (rose.flatten sample) + (loop [zipper (&.zip sample)] + (if (&.end? zipper) + (list (&.value zipper)) + (#.Cons (&.value zipper) + (recur (&.next zipper))))))) (test "Backwards zipper traversal yield reverse tree flatten." - (L/= (list;reverse (rose;flatten sample)) - (loop [zipper (to-end (&;zip sample))] - (if (&;root? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;prev zipper))))))) + (L/= (list.reverse (rose.flatten sample)) + (loop [zipper (to-end (&.zip sample))] + (if (&.root? zipper) + (list (&.value zipper)) + (#.Cons (&.value zipper) + (recur (&.prev zipper))))))) (test "Can remove nodes (except root nodes)." - (let [zipper (&;zip sample)] - (if (&;branch? zipper) - (and (|> zipper &;down &;root? not) - (|> zipper &;down &;remove (case> #;None false - (#;Some node) (&;root? node)))) - (|> zipper &;remove (case> #;None true - (#;Some _) false))))) + (let [zipper (&.zip sample)] + (if (&.branch? zipper) + (and (|> zipper &.down &.root? not) + (|> zipper &.down &.remove (case> #.None false + (#.Some node) (&.root? node)))) + (|> zipper &.remove (case> #.None true + (#.Some _) false))))) )))) diff --git a/stdlib/test/test/lux/data/color.lux b/stdlib/test/test/lux/data/color.lux index b4597b22a..ed62a221f 100644 --- a/stdlib/test/test/lux/data/color.lux +++ b/stdlib/test/test/lux/data/color.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do]) @@ -9,34 +9,34 @@ lux/test) (def: color - (r;Random @;Color) - (|> ($_ r;seq r;nat r;nat r;nat) - (:: r;Monad<Random> map @;color))) + (r.Random @.Color) + (|> ($_ r.seq r.nat r.nat r.nat) + (:: r.Monad<Random> map @.color))) (def: scale (-> Nat Frac) (|>> nat-to-int int-to-frac)) -(def: square (-> Frac Frac) (math;pow 2.0)) +(def: square (-> Frac Frac) (math.pow 2.0)) (def: (distance from to) - (-> @;Color @;Color Frac) - (let [[fr fg fb] (@;unpack from) - [tr tg tb] (@;unpack to)] - (math;root2 ($_ f/+ + (-> @.Color @.Color Frac) + (let [[fr fg fb] (@.unpack from) + [tr tg tb] (@.unpack to)] + (math.root2 ($_ f/+ (|> (scale tr) (f/- (scale fr)) square) (|> (scale tg) (f/- (scale fg)) square) (|> (scale tb) (f/- (scale fb)) square))))) (def: error-margin Frac 1.8) -(def: black @;Color (@;color [+0 +0 +0])) -(def: white @;Color (@;color [+255 +255 +255])) +(def: black @.Color (@.color [+0 +0 +0])) +(def: white @.Color (@.color [+255 +255 +255])) (do-template [<field>] [(def: (<field> color) - (-> @;Color Frac) - (let [[hue saturation luminance] (@;to-hsl color)] + (-> @.Color Frac) + (let [[hue saturation luminance] (@.to-hsl color)] <field>))] [saturation] @@ -48,47 +48,47 @@ (do @ [any color colorful (|> color - (r;filter (function [color] (|> (distance color black) (f/>= 100.0)))) - (r;filter (function [color] (|> (distance color white) (f/>= 100.0))))) + (r.filter (function [color] (|> (distance color black) (f/>= 100.0)))) + (r.filter (function [color] (|> (distance color white) (f/>= 100.0))))) mediocre (|> color - (r;filter (|>> saturation + (r.filter (|>> saturation ((function [saturation] (and (f/>= 0.25 saturation) (f/<= 0.75 saturation))))))) - ratio (|> r;frac (r;filter (f/>= 0.5)))] + ratio (|> r.frac (r.filter (f/>= 0.5)))] ($_ seq (test "Has equality." - (:: @;Eq<Color> = any any)) + (:: @.Eq<Color> = any any)) (test "Can convert to/from HSL." - (|> any @;to-hsl @;from-hsl + (|> any @.to-hsl @.from-hsl (distance any) (f/<= error-margin))) (test "Can convert to/from HSB." - (|> any @;to-hsb @;from-hsb + (|> any @.to-hsb @.from-hsb (distance any) (f/<= error-margin))) (test "Can convert to/from CMYK." - (|> any @;to-cmyk @;from-cmyk + (|> any @.to-cmyk @.from-cmyk (distance any) (f/<= error-margin))) (test "Can interpolate between 2 colors." (and (f/<= (distance colorful black) - (distance (@;darker ratio colorful) black)) + (distance (@.darker ratio colorful) black)) (f/<= (distance colorful white) - (distance (@;brighter ratio colorful) white)))) + (distance (@.brighter ratio colorful) white)))) (test "Can calculate complement." - (let [~any (@;complement any) - (^open "@/") @;Eq<Color>] + (let [~any (@.complement any) + (^open "@/") @.Eq<Color>] (and (not (@/= any ~any)) - (@/= any (@;complement ~any))))) + (@/= any (@.complement ~any))))) (test "Can saturate color." (f/> (saturation mediocre) - (saturation (@;saturate ratio mediocre)))) + (saturation (@.saturate ratio mediocre)))) (test "Can de-saturate color." (f/< (saturation mediocre) - (saturation (@;de-saturate ratio mediocre)))) + (saturation (@.de-saturate ratio mediocre)))) (test "Can gray-scale color." - (let [gray'ed (@;gray-scale mediocre)] + (let [gray'ed (@.gray-scale mediocre)] (and (f/= 0.0 (saturation gray'ed)) (|> (luminance gray'ed) diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/error.lux index 9eeec4fbc..f6c7d7a70 100644 --- a/stdlib/test/test/lux/data/error.lux +++ b/stdlib/test/test/lux/data/error.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -8,49 +8,49 @@ lux/test) (context: "Errors" - (let [(^open "&/") &;Monad<Error>] + (let [(^open "&/") &.Monad<Error>] ($_ seq (test "Functor correctly handles both cases." - (and (|> (: (&;Error Int) (#&;Success 10)) + (and (|> (: (&.Error Int) (#&.Success 10)) (&/map i/inc) - (case> (#&;Success 11) true _ false)) + (case> (#&.Success 11) true _ false)) - (|> (: (&;Error Int) (#&;Error "YOLO")) + (|> (: (&.Error Int) (#&.Error "YOLO")) (&/map i/inc) - (case> (#&;Error "YOLO") true _ false)) + (case> (#&.Error "YOLO") true _ false)) )) (test "Applicative correctly handles both cases." (and (|> (&/wrap 20) - (case> (#&;Success 20) true _ false)) + (case> (#&.Success 20) true _ false)) (|> (&/apply (&/wrap i/inc) (&/wrap 10)) - (case> (#&;Success 11) true _ false)) - (|> (&/apply (&/wrap i/inc) (#&;Error "YOLO")) - (case> (#&;Error "YOLO") true _ false)))) + (case> (#&.Success 11) true _ false)) + (|> (&/apply (&/wrap i/inc) (#&.Error "YOLO")) + (case> (#&.Error "YOLO") true _ false)))) (test "Monad correctly handles both cases." - (and (|> (do &;Monad<Error> + (and (|> (do &.Monad<Error> [f (wrap i/+) a (wrap 10) b (wrap 20)] (wrap (f a b))) - (case> (#&;Success 30) true _ false)) - (|> (do &;Monad<Error> + (case> (#&.Success 30) true _ false)) + (|> (do &.Monad<Error> [f (wrap i/+) - a (#&;Error "YOLO") + a (#&.Error "YOLO") b (wrap 20)] (wrap (f a b))) - (case> (#&;Error "YOLO") true _ false)) + (case> (#&.Error "YOLO") true _ false)) )) ))) (context: "Monad transformer" - (let [lift (&;lift io;Monad<IO>) - (^open "io/") io;Monad<IO>] + (let [lift (&.lift io.Monad<IO>) + (^open "io/") io.Monad<IO>] (test "Can add error functionality to any monad." - (|> (io;run (do (&;ErrorT io;Monad<IO>) + (|> (io.run (do (&.ErrorT io.Monad<IO>) [a (lift (io/wrap 123)) b (wrap 456)] (wrap (i/+ a b)))) - (case> (#&;Success 579) true + (case> (#&.Success 579) true _ false))))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index c8ba05f1d..5cbef91b0 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -28,41 +28,41 @@ ["tda" date] ["tdu" duration]) test) - (test (lux (time ["_;" instant] - ["_;" duration] - ["_;" date]))) + (test (lux (time ["_." instant] + ["_." duration] + ["_." date]))) ) (def: gen-json - (r;Random @;JSON) - (r;rec (function [gen-json] - (do r;Monad<Random> - [size (:: @ map (n/% +2) r;nat)] - ($_ r;alt + (r.Random @.JSON) + (r.rec (function [gen-json] + (do r.Monad<Random> + [size (:: @ map (n/% +2) r.nat)] + ($_ r.alt (:: @ wrap []) - r;bool - (|> r;frac (:: @ map (f/* 1_000_000.0))) - (r;text size) - (r;sequence size gen-json) - (r;dict text;Hash<Text> size (r;text size) gen-json) + r.bool + (|> r.frac (:: @ map (f/* 1_000_000.0))) + (r.text size) + (r.sequence size gen-json) + (r.dict text.Hash<Text> size (r.text size) gen-json) ))))) (context: "JSON" (<| (times +100) (do @ [sample gen-json - #let [(^open "@/") @;Eq<JSON> - (^open "@/") @;Codec<Text,JSON>]] + #let [(^open "@/") @.Eq<JSON> + (^open "@/") @.Codec<Text,JSON>]] ($_ seq (test "Every JSON is equal to itself." (@/= sample sample)) (test "Can encode/decode JSON." (|> sample @/encode @/decode - (case> (#;Right result) + (case> (#.Right result) (@/= sample result) - (#;Left _) + (#.Left _) false))) )))) @@ -84,82 +84,82 @@ ## #list (List Frac) ## #variant Variant ## #tuple [Bool Frac Text] - ## #dict (d;Dict Text Frac) + ## #dict (d.Dict Text Frac) ## #recursive Recursive - #instant ti;Instant - #duration tdu;Duration - #date tda;Date - #grams (unit;Qty unit;Gram) + #instant ti.Instant + #duration tdu.Duration + #date tda.Date + #grams (unit.Qty unit.Gram) }) (def: gen-recursive - (r;Random Recursive) - (r;rec (function [gen-recursive] - (r;alt r;frac - (r;seq r;frac gen-recursive))))) + (r.Random Recursive) + (r.rec (function [gen-recursive] + (r.alt r.frac + (r.seq r.frac gen-recursive))))) -(derived: (poly/eq;Eq<?> Recursive)) +(derived: (poly/eq.Eq<?> Recursive)) (def: (qty carrier) - (All [unit] (-> unit (r;Random (unit;Qty unit)))) - (|> r;int - (:: r;Monad<Random> map (unit;in carrier)))) + (All [unit] (-> unit (r.Random (unit.Qty unit)))) + (|> r.int + (:: r.Monad<Random> map (unit.in carrier)))) (def: gen-record - (r;Random Record) - (do r;Monad<Random> - [size (:: @ map (n/% +2) r;nat)] - ($_ r;seq + (r.Random Record) + (do r.Monad<Random> + [size (:: @ map (n/% +2) r.nat)] + ($_ r.seq ## (:: @ wrap []) - ## r;bool - ## r;frac - ## (r;text size) - ## (r;maybe r;frac) - ## (r;list size r;frac) - ## ($_ r;alt r;bool (r;text size) r;frac) - ## ($_ r;seq r;bool r;frac (r;text size)) - ## (r;dict text;Hash<Text> size (r;text size) r;frac) + ## r.bool + ## r.frac + ## (r.text size) + ## (r.maybe r.frac) + ## (r.list size r.frac) + ## ($_ r.alt r.bool (r.text size) r.frac) + ## ($_ r.seq r.bool r.frac (r.text size)) + ## (r.dict text.Hash<Text> size (r.text size) r.frac) ## gen-recursive - _instant;instant - _duration;duration - _date;date - (qty unit;@Gram) + _instant.instant + _duration.duration + _date.date + (qty unit.@Gram) ))) -(derived: (poly/json;Codec<JSON,?> Record)) +(derived: (poly/json.Codec<JSON,?> Record)) (struct: _ (Eq Record) (def: (= recL recR) (let [variant/= (function [left right] (case [left right] [(#Case0 left') (#Case0 right')] - (:: bool;Eq<Bool> = left' right') + (:: bool.Eq<Bool> = left' right') [(#Case1 left') (#Case1 right')] - (:: text;Eq<Text> = left' right') + (:: text.Eq<Text> = left' right') [(#Case2 left') (#Case2 right')] (f/= left' right') _ false))] - (and ## (:: bool;Eq<Bool> = (get@ #bool recL) (get@ #bool recR)) + (and ## (:: bool.Eq<Bool> = (get@ #bool recL) (get@ #bool recR)) ## (f/= (get@ #frac recL) (get@ #frac recR)) - ## (:: text;Eq<Text> = (get@ #text recL) (get@ #text recR)) - ## (:: (maybe;Eq<Maybe> number;Eq<Frac>) = (get@ #maybe recL) (get@ #maybe recR)) - ## (:: (list;Eq<List> number;Eq<Frac>) = (get@ #list recL) (get@ #list recR)) + ## (:: text.Eq<Text> = (get@ #text recL) (get@ #text recR)) + ## (:: (maybe.Eq<Maybe> number.Eq<Frac>) = (get@ #maybe recL) (get@ #maybe recR)) + ## (:: (list.Eq<List> number.Eq<Frac>) = (get@ #list recL) (get@ #list recR)) ## (variant/= (get@ #variant recL) (get@ #variant recR)) ## (let [[tL0 tL1 tL2] (get@ #tuple recL) ## [tR0 tR1 tR2] (get@ #tuple recR)] - ## (and (:: bool;Eq<Bool> = tL0 tR0) + ## (and (:: bool.Eq<Bool> = tL0 tR0) ## (f/= tL1 tR1) - ## (:: text;Eq<Text> = tL2 tR2))) - ## (:: (d;Eq<Dict> number;Eq<Frac>) = (get@ #dict recL) (get@ #dict recR)) + ## (:: text.Eq<Text> = tL2 tR2))) + ## (:: (d.Eq<Dict> number.Eq<Frac>) = (get@ #dict recL) (get@ #dict recR)) ## (:: Eq<Recursive> = (get@ #recursive recL) (get@ #recursive recR)) - (:: ti;Eq<Instant> = (get@ #instant recL) (get@ #instant recR)) - (:: tdu;Eq<Duration> = (get@ #duration recL) (get@ #duration recR)) - (:: tda;Eq<Date> = (get@ #date recL) (get@ #date recR)) - (:: unit;Eq<Unit> = (get@ #grams recL) (get@ #grams recR)) + (:: ti.Eq<Instant> = (get@ #instant recL) (get@ #instant recR)) + (:: tdu.Eq<Duration> = (get@ #duration recL) (get@ #duration recR)) + (:: tda.Eq<Date> = (get@ #date recL) (get@ #date recR)) + (:: unit.Eq<Unit> = (get@ #grams recL) (get@ #grams recR)) )))) (context: "Polytypism" @@ -171,8 +171,8 @@ (^open "@/") Codec<JSON,Record>]] (test "Can encode/decode arbitrary types." (|> sample @/encode @/decode - (case> (#e;Success result) + (case> (#e.Success result) (@/= sample result) - (#e;Error error) + (#e.Error error) false)))))) diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index 55709facc..fa8b719ca 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -23,54 +23,54 @@ "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) (def: xml-char^ - (r;Random Nat) - (do r;Monad<Random> - [idx (|> r;nat (:: @ map (n/% (text;size char-range))))] - (wrap (maybe;assume (text;nth idx char-range))))) + (r.Random Nat) + (do r.Monad<Random> + [idx (|> r.nat (:: @ map (n/% (text.size char-range))))] + (wrap (maybe.assume (text.nth idx char-range))))) (def: (size^ bottom top) - (-> Nat Nat (r;Random Nat)) + (-> Nat Nat (r.Random Nat)) (let [constraint (|>> (n/% top) (n/max bottom))] - (r/map constraint r;nat))) + (r/map constraint r.nat))) (def: (xml-text^ bottom top) - (-> Nat Nat (r;Random Text)) - (do r;Monad<Random> + (-> Nat Nat (r.Random Text)) + (do r.Monad<Random> [size (size^ bottom top)] - (r;text' xml-char^ size))) + (r.text' xml-char^ size))) (def: xml-identifier^ - (r;Random Ident) - (r;seq (xml-text^ +0 +10) + (r.Random Ident) + (r.seq (xml-text^ +0 +10) (xml-text^ +1 +10))) (def: gen-xml - (r;Random &;XML) - (r;rec (function [gen-xml] - (r;alt (xml-text^ +1 +10) - (do r;Monad<Random> + (r.Random &.XML) + (r.rec (function [gen-xml] + (r.alt (xml-text^ +1 +10) + (do r.Monad<Random> [size (size^ +0 +2)] - ($_ r;seq + ($_ r.seq xml-identifier^ - (r;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10)) - (r;list size gen-xml))))))) + (r.dict ident.Hash<Ident> size xml-identifier^ (xml-text^ +0 +10)) + (r.list size gen-xml))))))) (context: "XML." (<| (times +100) (do @ [sample gen-xml - #let [(^open "&/") &;Eq<XML> - (^open "&/") &;Codec<Text,XML>]] + #let [(^open "&/") &.Eq<XML> + (^open "&/") &.Codec<Text,XML>]] ($_ seq (test "Every XML is equal to itself." (&/= sample sample)) (test "Can encode/decode XML." (|> sample &/encode &/decode - (case> (#;Right result) + (case> (#.Right result) (&/= sample result) - (#;Left error) + (#.Left error) false))) )))) @@ -78,41 +78,41 @@ (<| (times +100) (do @ [text (xml-text^ +1 +10) - num-children (|> r;nat (:: @ map (n/% +5))) - children (r;list num-children (xml-text^ +1 +10)) + num-children (|> r.nat (:: @ map (n/% +5))) + children (r.list num-children (xml-text^ +1 +10)) tag xml-identifier^ attr xml-identifier^ value (xml-text^ +1 +10) - #let [node (#&;Node tag - (dict;put attr value &;attrs) - (L/map (|>> #&;Text) children))]] + #let [node (#&.Node tag + (dict.put attr value &.attrs) + (L/map (|>> #&.Text) children))]] ($_ seq (test "Can parse text." - (E;default false - (do E;Monad<Error> - [output (&;run (#&;Text text) - &;text)] + (E.default false + (do E.Monad<Error> + [output (&.run (#&.Text text) + &.text)] (wrap (text/= text output))))) (test "Can parse attributes." - (E;default false - (do E;Monad<Error> - [output (|> (&;attr attr) - (p;before &;ignore) - (&;run node))] + (E.default false + (do E.Monad<Error> + [output (|> (&.attr attr) + (p.before &.ignore) + (&.run node))] (wrap (text/= value output))))) (test "Can parse nodes." - (E;default false - (do E;Monad<Error> - [_ (|> (&;node tag) - (p;before &;ignore) - (&;run node))] + (E.default false + (do E.Monad<Error> + [_ (|> (&.node tag) + (p.before &.ignore) + (&.run node))] (wrap true)))) (test "Can parse children." - (E;default false - (do E;Monad<Error> - [outputs (|> (&;children (p;some &;text)) - (&;run node))] - (wrap (:: (list;Eq<List> text;Eq<Text>) = + (E.default false + (do E.Monad<Error> + [outputs (|> (&.children (p.some &.text)) + (&.run node))] + (wrap (:: (list.Eq<List> text.Eq<Text>) = children outputs))))) )))) diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux index 1f0554832..2e3b59853 100644 --- a/stdlib/test/test/lux/data/ident.lux +++ b/stdlib/test/test/lux/data/ident.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -10,30 +10,30 @@ lux/test) (def: (gen-part size) - (-> Nat (r;Random Text)) - (|> (r;text size) (r;filter (|>> (text;contains? ";") not)))) + (-> Nat (r.Random Text)) + (|> (r.text size) (r.filter (|>> (text.contains? ".") not)))) (context: "Idents" (<| (times +100) (do @ [## First Ident - sizeM1 (|> r;nat (:: @ map (n/% +100))) - sizeN1 (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) + sizeM1 (|> r.nat (:: @ map (n/% +100))) + sizeN1 (|> r.nat (:: @ map (|>> (n/% +100) (n/max +1)))) module1 (gen-part sizeM1) name1 (gen-part sizeN1) #let [ident1 [module1 name1]] ## Second Ident - sizeM2 (|> r;nat (:: @ map (n/% +100))) - sizeN2 (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) + sizeM2 (|> r.nat (:: @ map (n/% +100))) + sizeN2 (|> r.nat (:: @ map (|>> (n/% +100) (n/max +1)))) module2 (gen-part sizeM2) name2 (gen-part sizeN2) #let [ident2 [module2 name2]] - #let [(^open "&/") &;Eq<Ident> - (^open "&/") &;Codec<Text,Ident>]] + #let [(^open "&/") &.Eq<Ident> + (^open "&/") &.Codec<Text,Ident>]] ($_ seq (test "Can get the module & name parts of an ident." - (and (is module1 (&;module ident1)) - (is name1 (&;name ident1)))) + (and (is module1 (&.module ident1)) + (is name1 (&.name ident1)))) (test "Can compare idents for equality." (and (&/= ident1 ident1) @@ -46,26 +46,26 @@ (test "Can encode idents as text." (|> ident1 &/encode &/decode - (case> (#;Right dec-ident) (&/= ident1 dec-ident) + (case> (#.Right dec-ident) (&/= ident1 dec-ident) _ false))) (test "Encoding an ident without a module component results in text equal to the name of the ident." - (if (text;empty? module1) + (if (text.empty? module1) (text/= name1 (&/encode ident1)) true)) )))) (context: "Ident-related macros." - (let [(^open "&/") &;Eq<Ident>] + (let [(^open "&/") &.Eq<Ident>] ($_ seq (test "Can obtain Ident from symbol." - (and (&/= ["lux" "yolo"] (ident-for ;yolo)) - (&/= ["test/lux/data/ident" "yolo"] (ident-for ;;yolo)) + (and (&/= ["lux" "yolo"] (ident-for .yolo)) + (&/= ["test/lux/data/ident" "yolo"] (ident-for ..yolo)) (&/= ["" "yolo"] (ident-for yolo)) - (&/= ["lux/test" "yolo"] (ident-for lux/test;yolo)))) + (&/= ["lux/test" "yolo"] (ident-for lux/test.yolo)))) (test "Can obtain Ident from tag." - (and (&/= ["lux" "yolo"] (ident-for #;yolo)) - (&/= ["test/lux/data/ident" "yolo"] (ident-for #;;yolo)) + (and (&/= ["lux" "yolo"] (ident-for #.yolo)) + (&/= ["test/lux/data/ident" "yolo"] (ident-for #..yolo)) (&/= ["" "yolo"] (ident-for #yolo)) - (&/= ["lux/test" "yolo"] (ident-for #lux/test;yolo))))))) + (&/= ["lux/test" "yolo"] (ident-for #lux/test.yolo))))))) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux index 494811947..7ab4a6399 100644 --- a/stdlib/test/test/lux/data/identity.lux +++ b/stdlib/test/test/lux/data/identity.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -8,8 +8,8 @@ lux/test) (context: "Identity" - (let [(^open "&/") &;Monad<Identity> - (^open "&/") &;CoMonad<Identity>] + (let [(^open "&/") &.Monad<Identity> + (^open "&/") &.CoMonad<Identity>] ($_ seq (test "Functor does not affect values." (Text/= "yololol" (&/map (Text/compose "yolo") "lol"))) @@ -19,7 +19,7 @@ (Text/= "yololol" (&/apply (&/wrap (Text/compose "yolo")) (&/wrap "lol"))))) (test "Monad does not affect values." - (Text/= "yololol" (do &;Monad<Identity> + (Text/= "yololol" (do &.Monad<Identity> [f (wrap Text/compose) a (wrap "yolo") b (wrap "lol")] @@ -27,7 +27,7 @@ (test "CoMonad does not affect values." (and (Text/= "yololol" (&/unwrap "yololol")) - (Text/= "yololol" (be &;CoMonad<Identity> + (Text/= "yololol" (be &.CoMonad<Identity> [f Text/compose a "yolo" b "lol"] diff --git a/stdlib/test/test/lux/data/lazy.lux b/stdlib/test/test/lux/data/lazy.lux index 52e850d80..c007990de 100644 --- a/stdlib/test/test/lux/data/lazy.lux +++ b/stdlib/test/test/lux/data/lazy.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -9,49 +9,49 @@ (context: "Lazy." (<| (times +100) (do @ - [left r;nat - right r;nat - #let [lazy (&;freeze (n/* left right)) + [left r.nat + right r.nat + #let [lazy (&.freeze (n/* left right)) expected (n/* left right)]] ($_ seq (test "Lazying does not alter the expected value." (n/= expected - (&;thaw lazy))) + (&.thaw lazy))) (test "Lazy values only evaluate once." (and (not (is expected - (&;thaw lazy))) - (is (&;thaw lazy) - (&;thaw lazy)))) + (&.thaw lazy))) + (is (&.thaw lazy) + (&.thaw lazy)))) )))) (context: "Functor, Applicative, Monad." (<| (times +100) (do @ - [sample r;nat] + [sample r.nat] ($_ seq (test "Functor map." - (|> (&;freeze sample) - (:: &;Functor<Lazy> map n/inc) - &;thaw + (|> (&.freeze sample) + (:: &.Functor<Lazy> map n/inc) + &.thaw (n/= (n/inc sample)))) (test "Applicative wrap." (|> sample - (:: &;Applicative<Lazy> wrap) - &;thaw + (:: &.Applicative<Lazy> wrap) + &.thaw (n/= sample))) (test "Applicative apply." - (let [(^open "&/") &;Applicative<Lazy>] + (let [(^open "&/") &.Applicative<Lazy>] (|> (&/apply (&/wrap n/inc) (&/wrap sample)) - &;thaw + &.thaw (n/= (n/inc sample))))) (test "Monad." - (|> (do &;Monad<Lazy> + (|> (do &.Monad<Lazy> [f (wrap n/inc) a (wrap sample)] (wrap (f a))) - &;thaw + &.thaw (n/= (n/inc sample)))) )))) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux index 16d5c850d..4a2c98ab7 100644 --- a/stdlib/test/test/lux/data/maybe.lux +++ b/stdlib/test/test/lux/data/maybe.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -9,35 +9,35 @@ lux/test) (context: "Maybe" - (let [(^open "&/") &;Monoid<Maybe> - (^open "&/") &;Monad<Maybe> - (^open "Maybe/") (&;Eq<Maybe> text;Eq<Text>)] + (let [(^open "&/") &.Monoid<Maybe> + (^open "&/") &.Monad<Maybe> + (^open "Maybe/") (&.Eq<Maybe> text.Eq<Text>)] ($_ seq (test "Can compare Maybe values." - (and (Maybe/= #;None #;None) - (Maybe/= (#;Some "yolo") (#;Some "yolo")) - (not (Maybe/= (#;Some "yolo") (#;Some "lol"))) - (not (Maybe/= (#;Some "yolo") #;None)))) + (and (Maybe/= #.None #.None) + (Maybe/= (#.Some "yolo") (#.Some "yolo")) + (not (Maybe/= (#.Some "yolo") (#.Some "lol"))) + (not (Maybe/= (#.Some "yolo") #.None)))) (test "Monoid respects Maybe." - (and (Maybe/= #;None &/identity) - (Maybe/= (#;Some "yolo") (&/compose (#;Some "yolo") (#;Some "lol"))) - (Maybe/= (#;Some "yolo") (&/compose (#;Some "yolo") #;None)) - (Maybe/= (#;Some "lol") (&/compose #;None (#;Some "lol"))) - (Maybe/= #;None (: (Maybe Text) (&/compose #;None #;None))))) + (and (Maybe/= #.None &/identity) + (Maybe/= (#.Some "yolo") (&/compose (#.Some "yolo") (#.Some "lol"))) + (Maybe/= (#.Some "yolo") (&/compose (#.Some "yolo") #.None)) + (Maybe/= (#.Some "lol") (&/compose #.None (#.Some "lol"))) + (Maybe/= #.None (: (Maybe Text) (&/compose #.None #.None))))) (test "Functor respects Maybe." - (and (Maybe/= #;None (&/map (Text/compose "yolo") #;None)) - (Maybe/= (#;Some "yololol") (&/map (Text/compose "yolo") (#;Some "lol"))))) + (and (Maybe/= #.None (&/map (Text/compose "yolo") #.None)) + (Maybe/= (#.Some "yololol") (&/map (Text/compose "yolo") (#.Some "lol"))))) (test "Applicative respects Maybe." - (and (Maybe/= (#;Some "yolo") (&/wrap "yolo")) - (Maybe/= (#;Some "yololol") + (and (Maybe/= (#.Some "yolo") (&/wrap "yolo")) + (Maybe/= (#.Some "yololol") (&/apply (&/wrap (Text/compose "yolo")) (&/wrap "lol"))))) (test "Monad respects Maybe." - (Maybe/= (#;Some "yololol") - (do &;Monad<Maybe> + (Maybe/= (#.Some "yololol") + (do &.Monad<Maybe> [f (wrap Text/compose) a (wrap "yolo") b (wrap "lol")] @@ -45,12 +45,12 @@ ))) (context: "Monad transformer" - (let [lift (&;lift io;Monad<IO>) - (^open "io/") io;Monad<IO>] + (let [lift (&.lift io.Monad<IO>) + (^open "io/") io.Monad<IO>] (test "Can add maybe functionality to any monad." - (|> (io;run (do (&;MaybeT io;Monad<IO>) + (|> (io.run (do (&.MaybeT io.Monad<IO>) [a (lift (io/wrap 123)) b (wrap 456)] (wrap (i/+ a b)))) - (case> (#;Some 579) true + (case> (#.Some 579) true _ false))))) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index 7522f46ef..0f14bee64 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -20,10 +20,10 @@ (:: <Order> < y x) (:: <Order> > y x)))))))] - ["Nat" r;nat Eq<Nat> Order<Nat>] - ["Int" r;int Eq<Int> Order<Int>] - ["Frac" r;frac Eq<Frac> Order<Frac>] - ["Deg" r;deg Eq<Deg> Order<Deg>] + ["Nat" r.nat Eq<Nat> Order<Nat>] + ["Int" r.int Eq<Int> Order<Int>] + ["Frac" r.frac Eq<Frac> Order<Frac>] + ["Deg" r.deg Eq<Deg> Order<Deg>] ) (do-template [category rand-gen <Number> <Order>] @@ -43,10 +43,10 @@ (= x (* (signum x) (abs x)))))))))] - ## ["Nat" r;nat Number<Nat>] - ["Int" r;int Number<Int> Order<Int>] - ["Frac" r;frac Number<Frac> Order<Frac>] - ["Deg" r;deg Number<Deg> Order<Deg>] + ## ["Nat" r.nat Number<Nat>] + ["Int" r.int Number<Int> Order<Int>] + ["Frac" r.frac Number<Frac> Order<Frac>] + ["Deg" r.deg Number<Deg> Order<Deg>] ) (do-template [category rand-gen <Enum> <Number> <Order>] @@ -67,32 +67,32 @@ (|> x (:: <Enum> succ) (:: <Enum> pred))) ))))))] - ["Nat" r;nat Enum<Nat> Number<Nat> Order<Nat>] - ["Int" r;int Enum<Int> Number<Int> Order<Int>] + ["Nat" r.nat Enum<Nat> Number<Nat> Order<Nat>] + ["Int" r.int Enum<Int> Number<Int> Order<Int>] ) (do-template [category rand-gen <Number> <Order> <Interval> <test>] [(context: (format "[" category "] " "Interval") (<| (times +100) (do @ - [x (|> rand-gen (r;filter <test>)) + [x (|> rand-gen (r.filter <test>)) #let [(^open) <Number> (^open) <Order>]] (test "" (and (<= x (:: <Interval> bottom)) (>= x (:: <Interval> top)))))))] - ["Nat" r;nat Number<Nat> Order<Nat> Interval<Nat> (function [_] true)] - ["Int" r;int Number<Int> Order<Int> Interval<Int> (function [_] true)] + ["Nat" r.nat Number<Nat> Order<Nat> Interval<Nat> (function [_] true)] + ["Int" r.int Number<Int> Order<Int> Interval<Int> (function [_] true)] ## Both min and max values will be positive (thus, greater than zero) - ["Frac" r;frac Number<Frac> Order<Frac> Interval<Frac> (f/> 0.0)] - ["Deg" r;deg Number<Deg> Order<Deg> Interval<Deg> (function [_] true)] + ["Frac" r.frac Number<Frac> Order<Frac> Interval<Frac> (f/> 0.0)] + ["Deg" r.deg Number<Deg> Order<Deg> Interval<Deg> (function [_] true)] ) (do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>] [(context: (format "[" category "] " "Monoid") (<| (times +100) (do @ - [x (|> rand-gen (:: @ map (|>> (:: <Number> abs) <cap>)) (r;filter <test>)) + [x (|> rand-gen (:: @ map (|>> (:: <Number> abs) <cap>)) (r.filter <test>)) #let [(^open) <Number> (^open) <Order> (^open) <Monoid>]] @@ -101,22 +101,22 @@ (= x (compose x identity)) (= identity (compose identity identity)))))))] - ["Nat/Add" r;nat Number<Nat> Order<Nat> Add@Monoid<Nat> (n/% +1000) (function [_] true)] - ["Nat/Mul" r;nat Number<Nat> Order<Nat> Mul@Monoid<Nat> (n/% +1000) (function [_] true)] - ["Nat/Min" r;nat Number<Nat> Order<Nat> Min@Monoid<Nat> (n/% +1000) (function [_] true)] - ["Nat/Max" r;nat Number<Nat> Order<Nat> Max@Monoid<Nat> (n/% +1000) (function [_] true)] - ["Int/Add" r;int Number<Int> Order<Int> Add@Monoid<Int> (i/% 1000) (function [_] true)] - ["Int/Mul" r;int Number<Int> Order<Int> Mul@Monoid<Int> (i/% 1000) (function [_] true)] - ["Int/Min" r;int Number<Int> Order<Int> Min@Monoid<Int> (i/% 1000) (function [_] true)] - ["Int/Max" r;int Number<Int> Order<Int> Max@Monoid<Int> (i/% 1000) (function [_] true)] - ["Frac/Add" r;frac Number<Frac> Order<Frac> Add@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] - ["Frac/Mul" r;frac Number<Frac> Order<Frac> Mul@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] - ["Frac/Min" r;frac Number<Frac> Order<Frac> Min@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] - ["Frac/Max" r;frac Number<Frac> Order<Frac> Max@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] - ["Deg/Add" r;deg Number<Deg> Order<Deg> Add@Monoid<Deg> (d/% .125) (function [_] true)] - ## ["Deg/Mul" r;deg Number<Deg> Order<Deg> Mul@Monoid<Deg> (d/% .125) (function [_] true)] - ["Deg/Min" r;deg Number<Deg> Order<Deg> Min@Monoid<Deg> (d/% .125) (function [_] true)] - ["Deg/Max" r;deg Number<Deg> Order<Deg> Max@Monoid<Deg> (d/% .125) (function [_] true)] + ["Nat/Add" r.nat Number<Nat> Order<Nat> Add@Monoid<Nat> (n/% +1000) (function [_] true)] + ["Nat/Mul" r.nat Number<Nat> Order<Nat> Mul@Monoid<Nat> (n/% +1000) (function [_] true)] + ["Nat/Min" r.nat Number<Nat> Order<Nat> Min@Monoid<Nat> (n/% +1000) (function [_] true)] + ["Nat/Max" r.nat Number<Nat> Order<Nat> Max@Monoid<Nat> (n/% +1000) (function [_] true)] + ["Int/Add" r.int Number<Int> Order<Int> Add@Monoid<Int> (i/% 1000) (function [_] true)] + ["Int/Mul" r.int Number<Int> Order<Int> Mul@Monoid<Int> (i/% 1000) (function [_] true)] + ["Int/Min" r.int Number<Int> Order<Int> Min@Monoid<Int> (i/% 1000) (function [_] true)] + ["Int/Max" r.int Number<Int> Order<Int> Max@Monoid<Int> (i/% 1000) (function [_] true)] + ["Frac/Add" r.frac Number<Frac> Order<Frac> Add@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] + ["Frac/Mul" r.frac Number<Frac> Order<Frac> Mul@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] + ["Frac/Min" r.frac Number<Frac> Order<Frac> Min@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] + ["Frac/Max" r.frac Number<Frac> Order<Frac> Max@Monoid<Frac> (f/% 1000.0) (f/> 0.0)] + ["Deg/Add" r.deg Number<Deg> Order<Deg> Add@Monoid<Deg> (d/% .125) (function [_] true)] + ## ["Deg/Mul" r.deg Number<Deg> Order<Deg> Mul@Monoid<Deg> (d/% .125) (function [_] true)] + ["Deg/Min" r.deg Number<Deg> Order<Deg> Min@Monoid<Deg> (d/% .125) (function [_] true)] + ["Deg/Max" r.deg Number<Deg> Order<Deg> Max@Monoid<Deg> (d/% .125) (function [_] true)] ) (do-template [<category> <rand-gen> <Eq> <Codec>] @@ -128,38 +128,38 @@ (|> x (:: <Codec> encode) (:: <Codec> decode) - (case> (#;Right x') + (case> (#.Right x') (:: <Eq> = x x') - (#;Left _) + (#.Left _) false))))))] - ["Nat/Binary" r;nat Eq<Nat> Binary@Codec<Text,Nat>] - ["Nat/Octal" r;nat Eq<Nat> Octal@Codec<Text,Nat>] - ["Nat/Decimal" r;nat Eq<Nat> Codec<Text,Nat>] - ["Nat/Hex" r;nat Eq<Nat> Hex@Codec<Text,Nat>] - - ["Int/Binary" r;int Eq<Int> Binary@Codec<Text,Int>] - ["Int/Octal" r;int Eq<Int> Octal@Codec<Text,Int>] - ["Int/Decimal" r;int Eq<Int> Codec<Text,Int>] - ["Int/Hex" r;int Eq<Int> Hex@Codec<Text,Int>] - - ["Deg/Binary" r;deg Eq<Deg> Binary@Codec<Text,Deg>] - ["Deg/Octal" r;deg Eq<Deg> Octal@Codec<Text,Deg>] - ["Deg/Decimal" r;deg Eq<Deg> Codec<Text,Deg>] - ["Deg/Hex" r;deg Eq<Deg> Hex@Codec<Text,Deg>] - - ["Frac/Binary" r;frac Eq<Frac> Binary@Codec<Text,Frac>] - ["Frac/Octal" r;frac Eq<Frac> Octal@Codec<Text,Frac>] - ["Frac/Decimal" r;frac Eq<Frac> Codec<Text,Frac>] - ["Frac/Hex" r;frac Eq<Frac> Hex@Codec<Text,Frac>] + ["Nat/Binary" r.nat Eq<Nat> Binary@Codec<Text,Nat>] + ["Nat/Octal" r.nat Eq<Nat> Octal@Codec<Text,Nat>] + ["Nat/Decimal" r.nat Eq<Nat> Codec<Text,Nat>] + ["Nat/Hex" r.nat Eq<Nat> Hex@Codec<Text,Nat>] + + ["Int/Binary" r.int Eq<Int> Binary@Codec<Text,Int>] + ["Int/Octal" r.int Eq<Int> Octal@Codec<Text,Int>] + ["Int/Decimal" r.int Eq<Int> Codec<Text,Int>] + ["Int/Hex" r.int Eq<Int> Hex@Codec<Text,Int>] + + ["Deg/Binary" r.deg Eq<Deg> Binary@Codec<Text,Deg>] + ["Deg/Octal" r.deg Eq<Deg> Octal@Codec<Text,Deg>] + ["Deg/Decimal" r.deg Eq<Deg> Codec<Text,Deg>] + ["Deg/Hex" r.deg Eq<Deg> Hex@Codec<Text,Deg>] + + ["Frac/Binary" r.frac Eq<Frac> Binary@Codec<Text,Frac>] + ["Frac/Octal" r.frac Eq<Frac> Octal@Codec<Text,Frac>] + ["Frac/Decimal" r.frac Eq<Frac> Codec<Text,Frac>] + ["Frac/Hex" r.frac Eq<Frac> Hex@Codec<Text,Frac>] ) (context: "Can convert frac values to/from their bit patterns." (<| (times +100) (do @ - [raw r;frac - factor (|> r;nat (:: @ map (|>> (n/% +1000) (n/max +1)))) + [raw r.frac + factor (|> r.nat (:: @ map (|>> (n/% +1000) (n/max +1)))) #let [sample (|> factor nat-to-int int-to-frac (f/* raw))]] (test "Can convert frac values to/from their bit patterns." (|> sample frac-to-bits bits-to-frac (f/= sample)))))) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index e642256b9..3bc0d6e6d 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -14,28 +14,28 @@ (def: margin-of-error Frac 1.0e-10) (def: (within? margin standard value) - (-> Frac &;Complex &;Complex Bool) - (let [real-dist (frac/abs (f/- (get@ #&;real standard) - (get@ #&;real value))) - imgn-dist (frac/abs (f/- (get@ #&;imaginary standard) - (get@ #&;imaginary value)))] + (-> Frac &.Complex &.Complex Bool) + (let [real-dist (frac/abs (f/- (get@ #&.real standard) + (get@ #&.real value))) + imgn-dist (frac/abs (f/- (get@ #&.imaginary standard) + (get@ #&.imaginary value)))] (and (f/< margin real-dist) (f/< margin imgn-dist)))) (def: gen-dim - (r;Random Frac) - (do r;Monad<Random> - [factor (|> r;nat (:: @ map (|>> (n/% +1000) (n/max +1)))) - measure (|> r;frac (r;filter (f/> 0.0)))] + (r.Random Frac) + (do r.Monad<Random> + [factor (|> r.nat (:: @ map (|>> (n/% +1000) (n/max +1)))) + measure (|> r.frac (r.filter (f/> 0.0)))] (wrap (f/* (|> factor nat-to-int int-to-frac) measure)))) (def: gen-complex - (r;Random &;Complex) - (do r;Monad<Random> + (r.Random &.Complex) + (do r.Monad<Random> [real gen-dim imaginary gen-dim] - (wrap (&;complex real imaginary)))) + (wrap (&.complex real imaginary)))) (context: "Construction" (<| (times +100) @@ -44,13 +44,13 @@ imaginary gen-dim] ($_ seq (test "Can build and tear apart complex numbers" - (let [r+i (&;complex real imaginary)] - (and (f/= real (get@ #&;real r+i)) - (f/= imaginary (get@ #&;imaginary r+i))))) + (let [r+i (&.complex real imaginary)] + (and (f/= real (get@ #&.real r+i)) + (f/= imaginary (get@ #&.imaginary r+i))))) (test "If either the real part or the imaginary part is NaN, the composite is NaN." - (and (&;not-a-number? (&;complex number;not-a-number imaginary)) - (&;not-a-number? (&;complex real number;not-a-number)))) + (and (&.not-a-number? (&.complex number.not-a-number imaginary)) + (&.not-a-number? (&.complex real number.not-a-number)))) )))) (context: "Absolute value" @@ -60,20 +60,20 @@ imaginary gen-dim] ($_ seq (test "Absolute value of complex >= absolute value of any of the parts." - (let [r+i (&;complex real imaginary) - abs (get@ #&;real (&;c/abs r+i))] + (let [r+i (&.complex real imaginary) + abs (get@ #&.real (&.c/abs r+i))] (and (f/>= (frac/abs real) abs) (f/>= (frac/abs imaginary) abs)))) (test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (number;not-a-number? (get@ #&;real (&;c/abs (&;complex number;not-a-number imaginary)))) - (number;not-a-number? (get@ #&;real (&;c/abs (&;complex real number;not-a-number)))))) + (and (number.not-a-number? (get@ #&.real (&.c/abs (&.complex number.not-a-number imaginary)))) + (number.not-a-number? (get@ #&.real (&.c/abs (&.complex real number.not-a-number)))))) (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex number;positive-infinity imaginary)))) - (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex real number;positive-infinity)))) - (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex number;negative-infinity imaginary)))) - (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex real number;negative-infinity)))))) + (and (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex number.positive-infinity imaginary)))) + (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex real number.positive-infinity)))) + (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex number.negative-infinity imaginary)))) + (f/= number.positive-infinity (get@ #&.real (&.c/abs (&.complex real number.negative-infinity)))))) )))) (context: "Addidion, substraction, multiplication and division" @@ -84,40 +84,40 @@ factor gen-dim] ($_ seq (test "Adding 2 complex numbers is the same as adding their parts." - (let [z (&;c/+ y x)] - (and (&;c/= z - (&;complex (f/+ (get@ #&;real y) - (get@ #&;real x)) - (f/+ (get@ #&;imaginary y) - (get@ #&;imaginary x))))))) + (let [z (&.c/+ y x)] + (and (&.c/= z + (&.complex (f/+ (get@ #&.real y) + (get@ #&.real x)) + (f/+ (get@ #&.imaginary y) + (get@ #&.imaginary x))))))) (test "Subtracting 2 complex numbers is the same as adding their parts." - (let [z (&;c/- y x)] - (and (&;c/= z - (&;complex (f/- (get@ #&;real y) - (get@ #&;real x)) - (f/- (get@ #&;imaginary y) - (get@ #&;imaginary x))))))) + (let [z (&.c/- y x)] + (and (&.c/= z + (&.complex (f/- (get@ #&.real y) + (get@ #&.real x)) + (f/- (get@ #&.imaginary y) + (get@ #&.imaginary x))))))) (test "Subtraction is the inverse of addition." - (and (|> x (&;c/+ y) (&;c/- y) (within? margin-of-error x)) - (|> x (&;c/- y) (&;c/+ y) (within? margin-of-error x)))) + (and (|> x (&.c/+ y) (&.c/- y) (within? margin-of-error x)) + (|> x (&.c/- y) (&.c/+ y) (within? margin-of-error x)))) (test "Division is the inverse of multiplication." - (|> x (&;c/* y) (&;c// y) (within? margin-of-error x))) + (|> x (&.c/* y) (&.c// y) (within? margin-of-error x))) (test "Scalar division is the inverse of scalar multiplication." - (|> x (&;c/*' factor) (&;c//' factor) (within? margin-of-error x))) + (|> x (&.c/*' factor) (&.c//' factor) (within? margin-of-error x))) (test "If you subtract the remainder, all divisions must be exact." - (let [rem (&;c/% y x) - quotient (|> x (&;c/- rem) (&;c// y)) + (let [rem (&.c/% y x) + quotient (|> x (&.c/- rem) (&.c// y)) floored (|> quotient - (update@ #&;real math;floor) - (update@ #&;imaginary math;floor))] + (update@ #&.real math.floor) + (update@ #&.imaginary math.floor))] (within? 0.000000000001 x - (|> quotient (&;c/* y) (&;c/+ rem))))) + (|> quotient (&.c/* y) (&.c/+ rem))))) )))) (context: "Conjugate, reciprocal, signum, negation" @@ -126,33 +126,33 @@ [x gen-complex] ($_ seq (test "Conjugate has same real part as original, and opposite of imaginary part." - (let [cx (&;conjugate x)] - (and (f/= (get@ #&;real x) - (get@ #&;real cx)) - (f/= (frac/negate (get@ #&;imaginary x)) - (get@ #&;imaginary cx))))) + (let [cx (&.conjugate x)] + (and (f/= (get@ #&.real x) + (get@ #&.real cx)) + (f/= (frac/negate (get@ #&.imaginary x)) + (get@ #&.imaginary cx))))) (test "The reciprocal functions is its own inverse." - (|> x &;reciprocal &;reciprocal (within? margin-of-error x))) + (|> x &.reciprocal &.reciprocal (within? margin-of-error x))) (test "x*(x^-1) = 1" - (|> x (&;c/* (&;reciprocal x)) (within? margin-of-error &;one))) + (|> x (&.c/* (&.reciprocal x)) (within? margin-of-error &.one))) (test "Absolute value of signum is always root2(2), 1 or 0." - (let [signum-abs (|> x &;c/signum &;c/abs (get@ #&;real))] + (let [signum-abs (|> x &.c/signum &.c/abs (get@ #&.real))] (or (f/= 0.0 signum-abs) (f/= 1.0 signum-abs) - (f/= (math;root2 2.0) signum-abs)))) + (f/= (math.root2 2.0) signum-abs)))) (test "Negation is its own inverse." - (let [there (&;c/negate x) - back-again (&;c/negate there)] - (and (not (&;c/= there x)) - (&;c/= back-again x)))) + (let [there (&.c/negate x) + back-again (&.c/negate there)] + (and (not (&.c/= there x)) + (&.c/= back-again x)))) (test "Negation doesn't change the absolute value." - (f/= (get@ #&;real (&;c/abs x)) - (get@ #&;real (&;c/abs (&;c/negate x))))) + (f/= (get@ #&.real (&.c/abs x)) + (get@ #&.real (&.c/abs (&.c/negate x))))) )))) (context: "Trigonometry" @@ -161,13 +161,13 @@ [x gen-complex] ($_ seq (test "Arc-sine is the inverse of sine." - (|> x &;sin &;asin (within? margin-of-error x))) + (|> x &.sin &.asin (within? margin-of-error x))) (test "Arc-cosine is the inverse of cosine." - (|> x &;cos &;acos (within? margin-of-error x))) + (|> x &.cos &.acos (within? margin-of-error x))) (test "Arc-tangent is the inverse of tangent." - (|> x &;tan &;atan (within? margin-of-error x))))))) + (|> x &.tan &.atan (within? margin-of-error x))))))) (context: "Power 2 and exponential/logarithm" (<| (times +100) @@ -175,19 +175,19 @@ [x gen-complex] ($_ seq (test "Square root is inverse of power 2.0" - (|> x (&;pow' 2.0) &;root2 (within? margin-of-error x))) + (|> x (&.pow' 2.0) &.root2 (within? margin-of-error x))) (test "Logarithm is inverse of exponentiation." - (|> x &;log &;exp (within? margin-of-error x))) + (|> x &.log &.exp (within? margin-of-error x))) )))) (context: "Complex roots" (<| (times +100) (do @ [sample gen-complex - degree (|> r;nat (:: @ map (|>> (n/max +1) (n/% +5))))] + degree (|> r.nat (:: @ map (|>> (n/max +1) (n/% +5))))] (test "Can calculate the N roots for any complex number." (|> sample - (&;nth-roots degree) - (list/map (&;pow' (|> degree nat-to-int int-to-frac))) - (list;every? (within? margin-of-error sample))))))) + (&.nth-roots degree) + (list/map (&.pow' (|> degree nat-to-int int-to-frac))) + (list.every? (within? margin-of-error sample))))))) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index c6fb2ac68..93081cd14 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -8,17 +8,17 @@ lux/test) (def: gen-part - (r;Random Nat) - (|> r;nat (:: r;Monad<Random> map (|>> (n/% +1000) (n/max +1))))) + (r.Random Nat) + (|> r.nat (:: r.Monad<Random> map (|>> (n/% +1000) (n/max +1))))) (def: gen-ratio - (r;Random &;Ratio) - (do r;Monad<Random> + (r.Random &.Ratio) + (do r.Monad<Random> [numerator gen-part denominator (|> gen-part - (r;filter (|>> (n/= +0) not)) - (r;filter (|>> (n/= numerator) not)))] - (wrap (&;ratio numerator denominator)))) + (r.filter (|>> (n/= +0) not)) + (r.filter (|>> (n/= numerator) not)))] + (wrap (&.ratio numerator denominator)))) (context: "Normalization" (<| (times +100) @@ -28,11 +28,11 @@ sample gen-ratio] ($_ seq (test "All zeroes are the same." - (&;r/= (&;ratio +0 denom1) - (&;ratio +0 denom2))) + (&.r/= (&.ratio +0 denom1) + (&.ratio +0 denom2))) (test "All ratios are built normalized." - (|> sample &;normalize (&;r/= sample))) + (|> sample &.normalize (&.r/= sample))) )))) (context: "Arithmetic" @@ -40,29 +40,29 @@ (do @ [x gen-ratio y gen-ratio - #let [min (&;r/min x y) - max (&;r/max x y)]] + #let [min (&.r/min x y) + max (&.r/max x y)]] ($_ seq (test "Addition and subtraction are opposites." - (and (|> max (&;r/- min) (&;r/+ min) (&;r/= max)) - (|> max (&;r/+ min) (&;r/- min) (&;r/= max)))) + (and (|> max (&.r/- min) (&.r/+ min) (&.r/= max)) + (|> max (&.r/+ min) (&.r/- min) (&.r/= max)))) (test "Multiplication and division are opposites." - (and (|> max (&;r// min) (&;r/* min) (&;r/= max)) - (|> max (&;r/* min) (&;r// min) (&;r/= max)))) + (and (|> max (&.r// min) (&.r/* min) (&.r/= max)) + (|> max (&.r/* min) (&.r// min) (&.r/= max)))) (test "Modulus by a larger ratio doesn't change the value." - (|> min (&;r/% max) (&;r/= min))) + (|> min (&.r/% max) (&.r/= min))) (test "Modulus by a smaller ratio results in a value smaller than the limit." - (|> max (&;r/% min) (&;r/< min))) + (|> max (&.r/% min) (&.r/< min))) (test "Can get the remainder of a division." - (let [remainder (&;r/% min max) - multiple (&;r/- remainder max) - factor (&;r// min multiple)] - (and (|> factor (get@ #&;denominator) (n/= +1)) - (|> factor (&;r/* min) (&;r/+ remainder) (&;r/= max))))) + (let [remainder (&.r/% min max) + multiple (&.r/- remainder max) + factor (&.r// min multiple)] + (and (|> factor (get@ #&.denominator) (n/= +1)) + (|> factor (&.r/* min) (&.r/+ remainder) (&.r/= max))))) )))) (context: "Negation, absolute value and signum" @@ -73,14 +73,14 @@ (test "Negation is it's own inverse." (let [there (&/negate sample) back-again (&/negate there)] - (and (not (&;r/= there sample)) - (&;r/= back-again sample)))) + (and (not (&.r/= there sample)) + (&.r/= back-again sample)))) (test "All ratios are already at their absolute value." - (|> sample &/abs (&;r/= sample))) + (|> sample &/abs (&.r/= sample))) (test "Signum is the identity." - (|> sample (&;r/* (&/signum sample)) (&;r/= sample))) + (|> sample (&.r/* (&/signum sample)) (&.r/= sample))) )))) (context: "Order" @@ -90,21 +90,21 @@ y gen-ratio] ($_ seq (test "Can compare ratios." - (and (or (&;r/<= y x) - (&;r/> y x)) - (or (&;r/>= y x) - (&;r/< y x)))) + (and (or (&.r/<= y x) + (&.r/> y x)) + (or (&.r/>= y x) + (&.r/< y x)))) )))) (context: "Codec" (<| (times +100) (do @ [sample gen-ratio - #let [(^open "&/") &;Codec<Text,Ratio>]] + #let [(^open "&/") &.Codec<Text,Ratio>]] (test "Can encode/decode ratios." (|> sample &/encode &/decode - (case> (#;Right output) - (&;r/= sample output) + (case> (#.Right output) + (&.r/= sample output) _ false)))))) diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux index 11f394af6..0bf0cdedd 100644 --- a/stdlib/test/test/lux/data/product.lux +++ b/stdlib/test/test/lux/data/product.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad]) diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux index b5e4db76e..367c010de 100644 --- a/stdlib/test/test/lux/data/sum.lux +++ b/stdlib/test/test/lux/data/sum.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -10,7 +10,7 @@ lux/test) (context: "Sum operations" - (let [(^open "List/") (list;Eq<List> text;Eq<Text>)] + (let [(^open "List/") (list.Eq<List> text.Eq<Text>)] ($_ seq (test "Can inject values into Either." (and (|> (left "Hello") (case> (+0 "Hello") true _ false)) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index ea6c1185b..42685e03f 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -13,40 +13,40 @@ (context: "Size" (<| (times +100) (do @ - [size (:: @ map (n/% +100) r;nat) - sample (r;text size)] + [size (:: @ map (n/% +100) r.nat) + sample (r.text size)] (test "" (or (and (n/= +0 size) - (&;empty? sample)) - (n/= size (&;size sample))))))) + (&.empty? sample)) + (n/= size (&.size sample))))))) (def: bounded-size - (r;Random Nat) - (|> r;nat - (:: r;Monad<Random> map (|>> (n/% +20) (n/+ +1))))) + (r.Random Nat) + (|> r.nat + (:: r.Monad<Random> map (|>> (n/% +20) (n/+ +1))))) (context: "Locations" (<| (times +100) (do @ [size bounded-size - idx (:: @ map (n/% size) r;nat) - sample (r;text size)] + idx (:: @ map (n/% size) r.nat) + sample (r.text size)] (test "" (|> sample - (&;nth idx) - (case> (^multi (#;Some char) - [(&;from-code char) char] - [[(&;index-of char sample) - (&;last-index-of char sample) - (&;index-of' char idx sample) - (&;last-index-of' char idx sample)] - [(#;Some io) (#;Some lio) - (#;Some io') (#;Some lio')]]) + (&.nth idx) + (case> (^multi (#.Some char) + [(&.from-code char) char] + [[(&.index-of char sample) + (&.last-index-of char sample) + (&.index-of' char idx sample) + (&.last-index-of' char idx sample)] + [(#.Some io) (#.Some lio) + (#.Some io') (#.Some lio')]]) (and (n/<= idx io) (n/>= idx lio) (n/= idx io') (n/>= idx lio') - (&;contains? char sample)) + (&.contains? char sample)) _ false @@ -58,34 +58,34 @@ (do @ [sizeL bounded-size sizeR bounded-size - sampleL (r;text sizeL) - sampleR (r;text sizeR) - #let [sample (&;concat (list sampleL sampleR)) - fake-sample (&;join-with " " (list sampleL sampleR)) - dup-sample (&;join-with "" (list sampleL sampleR)) - enclosed-sample (&;enclose [sampleR sampleR] sampleL) - (^open) &;Eq<Text>]] + sampleL (r.text sizeL) + sampleR (r.text sizeR) + #let [sample (&.concat (list sampleL sampleR)) + fake-sample (&.join-with " " (list sampleL sampleR)) + dup-sample (&.join-with "" (list sampleL sampleR)) + enclosed-sample (&.enclose [sampleR sampleR] sampleL) + (^open) &.Eq<Text>]] (test "" (and (not (= sample fake-sample)) (= sample dup-sample) - (&;starts-with? sampleL sample) - (&;ends-with? sampleR sample) + (&.starts-with? sampleL sample) + (&.ends-with? sampleR sample) (= enclosed-sample - (&;enclose' sampleR sampleL)) + (&.enclose' sampleR sampleL)) - (|> (&;split sizeL sample) - (case> (#;Right [_l _r]) + (|> (&.split sizeL sample) + (case> (#.Right [_l _r]) (and (= sampleL _l) (= sampleR _r) - (= sample (&;concat (list _l _r)))) + (= sample (&.concat (list _l _r)))) _ false)) - (|> [(&;clip +0 sizeL sample) - (&;clip sizeL (&;size sample) sample) - (&;clip' sizeL sample) - (&;clip' +0 sample)] - (case> [(#;Right _l) (#;Right _r) (#;Right _r') (#;Right _f)] + (|> [(&.clip +0 sizeL sample) + (&.clip sizeL (&.size sample) sample) + (&.clip' sizeL sample) + (&.clip' +0 sample)] + (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] (and (= sampleL _l) (= sampleR _r) (= _r _r') @@ -104,35 +104,35 @@ #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> r;nat (:: @ map (|>> (n/% +128) (n/max +1))))] - sep1 (r;text' normal-char-gen +1) - sep2 (r;text' normal-char-gen +1) - #let [part-gen (|> (r;text' normal-char-gen sizeP) - (r;filter (|>> (&;contains? sep1) not)))] - parts (r;list sizeL part-gen) - #let [sample1 (&;concat (list;interpose sep1 parts)) - sample2 (&;concat (list;interpose sep2 parts)) - (^open "&/") &;Eq<Text>]] + normal-char-gen (|> r.nat (:: @ map (|>> (n/% +128) (n/max +1))))] + sep1 (r.text' normal-char-gen +1) + sep2 (r.text' normal-char-gen +1) + #let [part-gen (|> (r.text' normal-char-gen sizeP) + (r.filter (|>> (&.contains? sep1) not)))] + parts (r.list sizeL part-gen) + #let [sample1 (&.concat (list.interpose sep1 parts)) + sample2 (&.concat (list.interpose sep2 parts)) + (^open "&/") &.Eq<Text>]] ($_ seq (test "Can split text through a separator." - (n/= (list;size parts) - (list;size (&;split-all-with sep1 sample1)))) + (n/= (list.size parts) + (list.size (&.split-all-with sep1 sample1)))) (test "Can replace occurrences of a piece of text inside a larger text." (&/= sample2 - (&;replace-all sep1 sep2 sample1))) + (&.replace-all sep1 sep2 sample1))) )))) (context: "Other text functions" - (let [(^open "&/") &;Eq<Text>] + (let [(^open "&/") &.Eq<Text>] ($_ seq (test "Can transform texts in certain ways." - (and (&/= "abc" (&;lower-case "ABC")) - (&/= "ABC" (&;upper-case "abc")))) + (and (&/= "abc" (&.lower-case "ABC")) + (&/= "ABC" (&.upper-case "abc")))) ))) (context: "Structures" - (let [(^open "&/") &;Order<Text>] + (let [(^open "&/") &.Order<Text>] ($_ seq (test "" (&/< "bcd" "abc")) (test "" (not (&/< "abc" "abc"))) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index d1f7fc9f0..8232fe82d 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -8,7 +8,7 @@ lux/test) (context: "Formatters" - (let [(^open "&/") text;Eq<Text>] + (let [(^open "&/") text.Eq<Text>] ($_ seq (test "Can format common values simply." (and (&/= "true" (%b true)) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index 331ca42ea..7cf084158 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] pipe @@ -14,39 +14,39 @@ ## [Utils] (def: (should-fail input) - (All [a] (-> (E;Error a) Bool)) + (All [a] (-> (E.Error a) Bool)) (case input - (#;Left _) true + (#.Left _) true _ false)) (def: (should-passT test input) - (-> Text (E;Error Text) Bool) + (-> Text (E.Error Text) Bool) (case input - (#;Right output) + (#.Right output) (text/= test output) _ false)) (def: (should-passL test input) - (-> (List Text) (E;Error (List Text)) Bool) - (let [(^open "list/") (list;Eq<List> text;Eq<Text>)] + (-> (List Text) (E.Error (List Text)) Bool) + (let [(^open "list/") (list.Eq<List> text.Eq<Text>)] (case input - (#;Right output) + (#.Right output) (list/= test output) _ false))) (def: (should-passE test input) - (-> (Either Text Text) (E;Error (Either Text Text)) Bool) + (-> (Either Text Text) (E.Error (Either Text Text)) Bool) (case input - (#;Right output) + (#.Right output) (case [test output] - [(#;Left test) (#;Left output)] + [(#.Left test) (#.Left output)] (text/= test output) - [(#;Right test) (#;Right output)] + [(#.Right test) (#.Right output)] (text/= test output) _ @@ -59,144 +59,144 @@ (context: "End" ($_ seq (test "Can detect the end of the input." - (|> (&;run "" - &;end) - (case> (#;Right _) true _ false))) + (|> (&.run "" + &.end) + (case> (#.Right _) true _ false))) (test "Won't mistake non-empty text for no more input." - (|> (&;run "YOLO" - &;end) - (case> (#;Left _) true _ false))) + (|> (&.run "YOLO" + &.end) + (case> (#.Left _) true _ false))) )) (context: "Literals" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) - sample (r;text size) - non-sample (|> (r;text size) - (r;filter (|>> (text/= sample) not)))] + [size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) + sample (r.text size) + non-sample (|> (r.text size) + (r.filter (|>> (text/= sample) not)))] ($_ seq (test "Can find literal text fragments." - (and (|> (&;run sample - (&;this sample)) - (case> (#;Right []) true _ false)) - (|> (&;run non-sample - (&;this sample)) - (case> (#;Left _) true _ false)))) + (and (|> (&.run sample + (&.this sample)) + (case> (#.Right []) true _ false)) + (|> (&.run non-sample + (&.this sample)) + (case> (#.Left _) true _ false)))) )))) (context: "Custom lexers" ($_ seq (test "Can lex anything" - (and (should-passT "A" (&;run "A" - &;any)) - (should-fail (&;run "" - &;any)))) + (and (should-passT "A" (&.run "A" + &.any)) + (should-fail (&.run "" + &.any)))) (test "Can lex characters ranges." - (and (should-passT "Y" (&;run "Y" - (&;range (char "X") (char "Z")))) - (should-fail (&;run "M" - (&;range (char "X") (char "Z")))))) + (and (should-passT "Y" (&.run "Y" + (&.range (char "X") (char "Z")))) + (should-fail (&.run "M" + (&.range (char "X") (char "Z")))))) - (test "Can lex upper-case and &;lower-case letters." - (and (should-passT "Y" (&;run "Y" - &;upper)) - (should-fail (&;run "m" - &;upper)) + (test "Can lex upper-case and &.lower-case letters." + (and (should-passT "Y" (&.run "Y" + &.upper)) + (should-fail (&.run "m" + &.upper)) - (should-passT "y" (&;run "y" - &;lower)) - (should-fail (&;run "M" - &;lower)))) + (should-passT "y" (&.run "y" + &.lower)) + (should-fail (&.run "M" + &.lower)))) (test "Can lex numbers." - (and (should-passT "1" (&;run "1" - &;decimal)) - (should-fail (&;run " " - &;decimal)) - - (should-passT "7" (&;run "7" - &;octal)) - (should-fail (&;run "8" - &;octal)) - - (should-passT "1" (&;run "1" - &;hexadecimal)) - (should-passT "a" (&;run "a" - &;hexadecimal)) - (should-passT "A" (&;run "A" - &;hexadecimal)) - (should-fail (&;run " " - &;hexadecimal)) + (and (should-passT "1" (&.run "1" + &.decimal)) + (should-fail (&.run " " + &.decimal)) + + (should-passT "7" (&.run "7" + &.octal)) + (should-fail (&.run "8" + &.octal)) + + (should-passT "1" (&.run "1" + &.hexadecimal)) + (should-passT "a" (&.run "a" + &.hexadecimal)) + (should-passT "A" (&.run "A" + &.hexadecimal)) + (should-fail (&.run " " + &.hexadecimal)) )) (test "Can lex alphabetic characters." - (and (should-passT "A" (&;run "A" - &;alpha)) - (should-passT "a" (&;run "a" - &;alpha)) - (should-fail (&;run "1" - &;alpha)))) + (and (should-passT "A" (&.run "A" + &.alpha)) + (should-passT "a" (&.run "a" + &.alpha)) + (should-fail (&.run "1" + &.alpha)))) (test "Can lex alphanumeric characters." - (and (should-passT "A" (&;run "A" - &;alpha-num)) - (should-passT "a" (&;run "a" - &;alpha-num)) - (should-passT "1" (&;run "1" - &;alpha-num)) - (should-fail (&;run " " - &;alpha-num)))) + (and (should-passT "A" (&.run "A" + &.alpha-num)) + (should-passT "a" (&.run "a" + &.alpha-num)) + (should-passT "1" (&.run "1" + &.alpha-num)) + (should-fail (&.run " " + &.alpha-num)))) (test "Can lex white-space." - (and (should-passT " " (&;run " " - &;space)) - (should-fail (&;run "8" - &;space)))) + (and (should-passT " " (&.run " " + &.space)) + (should-fail (&.run "8" + &.space)))) )) (context: "Combinators" ($_ seq (test "Can combine lexers sequentially." - (and (|> (&;run "YO" - (p;seq &;any &;any)) - (case> (#;Right ["Y" "O"]) true + (and (|> (&.run "YO" + (p.seq &.any &.any)) + (case> (#.Right ["Y" "O"]) true _ false)) - (should-fail (&;run "Y" - (p;seq &;any &;any))))) + (should-fail (&.run "Y" + (p.seq &.any &.any))))) (test "Can create the opposite of a lexer." - (and (should-passT "a" (&;run "a" - (&;not (p;alt &;decimal &;upper)))) - (should-fail (&;run "A" - (&;not (p;alt &;decimal &;upper)))))) + (and (should-passT "a" (&.run "a" + (&.not (p.alt &.decimal &.upper)))) + (should-fail (&.run "A" + (&.not (p.alt &.decimal &.upper)))))) (test "Can select from among a set of characters." - (and (should-passT "C" (&;run "C" - (&;one-of "ABC"))) - (should-fail (&;run "D" - (&;one-of "ABC"))))) + (and (should-passT "C" (&.run "C" + (&.one-of "ABC"))) + (should-fail (&.run "D" + (&.one-of "ABC"))))) (test "Can avoid a set of characters." - (and (should-passT "D" (&;run "D" - (&;none-of "ABC"))) - (should-fail (&;run "C" - (&;none-of "ABC"))))) + (and (should-passT "D" (&.run "D" + (&.none-of "ABC"))) + (should-fail (&.run "C" + (&.none-of "ABC"))))) (test "Can lex using arbitrary predicates." - (and (should-passT "D" (&;run "D" - (&;satisfies (function [c] true)))) - (should-fail (&;run "C" - (&;satisfies (function [c] false)))))) + (and (should-passT "D" (&.run "D" + (&.satisfies (function [c] true)))) + (should-fail (&.run "C" + (&.satisfies (function [c] false)))))) (test "Can apply a lexer multiple times." - (and (should-passT "0123456789ABCDEF" (&;run "0123456789ABCDEF" - (&;many &;hexadecimal))) - (should-fail (&;run "yolo" - (&;many &;hexadecimal))) + (and (should-passT "0123456789ABCDEF" (&.run "0123456789ABCDEF" + (&.many &.hexadecimal))) + (should-fail (&.run "yolo" + (&.many &.hexadecimal))) - (should-passT "" (&;run "" - (&;some &;hexadecimal))))) + (should-passT "" (&.run "" + (&.some &.hexadecimal))))) )) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 34d752d5a..7323aeb79 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -17,31 +17,31 @@ ## [Utils] (def: (should-pass regex input) - (-> (lexer;Lexer Text) Text Bool) - (|> (lexer;run input regex) - (case> (#;Right parsed) + (-> (lexer.Lexer Text) Text Bool) + (|> (lexer.run input regex) + (case> (#.Right parsed) (T/= parsed input) _ false))) (def: (should-passT test regex input) - (-> Text (lexer;Lexer Text) Text Bool) - (|> (lexer;run input regex) - (case> (#;Right parsed) + (-> Text (lexer.Lexer Text) Text Bool) + (|> (lexer.run input regex) + (case> (#.Right parsed) (T/= test parsed) _ false))) (def: (should-fail regex input) - (All [a] (-> (lexer;Lexer a) Text Bool)) - (|> (lexer;run input regex) - (case> (#;Left _) true _ false))) + (All [a] (-> (lexer.Lexer a) Text Bool)) + (|> (lexer.run input regex) + (case> (#.Left _) true _ false))) (syntax: (should-check pattern regex input) - (wrap (list (` (|> (lexer;run (~ input) (~ regex)) - (case> (^ (#;Right (~ pattern))) + (wrap (list (` (|> (lexer.run (~ input) (~ regex)) + (case> (^ (#.Right (~ pattern))) true (~' _) @@ -50,230 +50,230 @@ ## [Tests] (context: "Regular Expressions [Basics]" (test "Can parse character literals." - (and (should-pass (&;regex "a") "a") - (should-fail (&;regex "a") ".") - (should-pass (&;regex "\\.") ".") - (should-fail (&;regex "\\.") "a")))) + (and (should-pass (&.regex "a") "a") + (should-fail (&.regex "a") ".") + (should-pass (&.regex "\\.") ".") + (should-fail (&.regex "\\.") "a")))) (context: "Regular Expressions [System character classes]" ($_ seq (test "Can parse anything." - (should-pass (&;regex ".") "a")) + (should-pass (&.regex ".") "a")) (test "Can parse digits." - (and (should-pass (&;regex "\\d") "0") - (should-fail (&;regex "\\d") "m"))) + (and (should-pass (&.regex "\\d") "0") + (should-fail (&.regex "\\d") "m"))) (test "Can parse non digits." - (and (should-pass (&;regex "\\D") "m") - (should-fail (&;regex "\\D") "0"))) + (and (should-pass (&.regex "\\D") "m") + (should-fail (&.regex "\\D") "0"))) (test "Can parse white-space." - (and (should-pass (&;regex "\\s") " ") - (should-fail (&;regex "\\s") "m"))) + (and (should-pass (&.regex "\\s") " ") + (should-fail (&.regex "\\s") "m"))) (test "Can parse non white-space." - (and (should-pass (&;regex "\\S") "m") - (should-fail (&;regex "\\S") " "))) + (and (should-pass (&.regex "\\S") "m") + (should-fail (&.regex "\\S") " "))) (test "Can parse word characters." - (and (should-pass (&;regex "\\w") "_") - (should-fail (&;regex "\\w") "^"))) + (and (should-pass (&.regex "\\w") "_") + (should-fail (&.regex "\\w") "^"))) (test "Can parse non word characters." - (and (should-pass (&;regex "\\W") ".") - (should-fail (&;regex "\\W") "a"))) + (and (should-pass (&.regex "\\W") ".") + (should-fail (&.regex "\\W") "a"))) )) (context: "Regular Expressions [Special system character classes : Part 1]" ($_ seq (test "Can parse using special character classes." - (and (and (should-pass (&;regex "\\p{Lower}") "m") - (should-fail (&;regex "\\p{Lower}") "M")) + (and (and (should-pass (&.regex "\\p{Lower}") "m") + (should-fail (&.regex "\\p{Lower}") "M")) - (and (should-pass (&;regex "\\p{Upper}") "M") - (should-fail (&;regex "\\p{Upper}") "m")) + (and (should-pass (&.regex "\\p{Upper}") "M") + (should-fail (&.regex "\\p{Upper}") "m")) - (and (should-pass (&;regex "\\p{Alpha}") "M") - (should-fail (&;regex "\\p{Alpha}") "0")) + (and (should-pass (&.regex "\\p{Alpha}") "M") + (should-fail (&.regex "\\p{Alpha}") "0")) - (and (should-pass (&;regex "\\p{Digit}") "1") - (should-fail (&;regex "\\p{Digit}") "n")) + (and (should-pass (&.regex "\\p{Digit}") "1") + (should-fail (&.regex "\\p{Digit}") "n")) - (and (should-pass (&;regex "\\p{Alnum}") "1") - (should-fail (&;regex "\\p{Alnum}") ".")) + (and (should-pass (&.regex "\\p{Alnum}") "1") + (should-fail (&.regex "\\p{Alnum}") ".")) - (and (should-pass (&;regex "\\p{Space}") " ") - (should-fail (&;regex "\\p{Space}") ".")) + (and (should-pass (&.regex "\\p{Space}") " ") + (should-fail (&.regex "\\p{Space}") ".")) )) )) (context: "Regular Expressions [Special system character classes : Part 2]" ($_ seq (test "Can parse using special character classes." - (and (and (should-pass (&;regex "\\p{HexDigit}") "a") - (should-fail (&;regex "\\p{HexDigit}") ".")) + (and (and (should-pass (&.regex "\\p{HexDigit}") "a") + (should-fail (&.regex "\\p{HexDigit}") ".")) - (and (should-pass (&;regex "\\p{OctDigit}") "6") - (should-fail (&;regex "\\p{OctDigit}") ".")) + (and (should-pass (&.regex "\\p{OctDigit}") "6") + (should-fail (&.regex "\\p{OctDigit}") ".")) - (and (should-pass (&;regex "\\p{Blank}") "\t") - (should-fail (&;regex "\\p{Blank}") ".")) + (and (should-pass (&.regex "\\p{Blank}") "\t") + (should-fail (&.regex "\\p{Blank}") ".")) - (and (should-pass (&;regex "\\p{ASCII}") "\t") - (should-fail (&;regex "\\p{ASCII}") "\u1234")) + (and (should-pass (&.regex "\\p{ASCII}") "\t") + (should-fail (&.regex "\\p{ASCII}") "\u1234")) - (and (should-pass (&;regex "\\p{Contrl}") "\u0012") - (should-fail (&;regex "\\p{Contrl}") "a")) + (and (should-pass (&.regex "\\p{Contrl}") "\u0012") + (should-fail (&.regex "\\p{Contrl}") "a")) - (and (should-pass (&;regex "\\p{Punct}") "@") - (should-fail (&;regex "\\p{Punct}") "a")) + (and (should-pass (&.regex "\\p{Punct}") "@") + (should-fail (&.regex "\\p{Punct}") "a")) - (and (should-pass (&;regex "\\p{Graph}") "@") - (should-fail (&;regex "\\p{Graph}") " ")) + (and (should-pass (&.regex "\\p{Graph}") "@") + (should-fail (&.regex "\\p{Graph}") " ")) - (and (should-pass (&;regex "\\p{Print}") "\u0020") - (should-fail (&;regex "\\p{Print}") "\u1234")) + (and (should-pass (&.regex "\\p{Print}") "\u0020") + (should-fail (&.regex "\\p{Print}") "\u1234")) )) )) (context: "Regular Expressions [Custom character classes : Part 1]" ($_ seq (test "Can parse using custom character classes." - (and (should-pass (&;regex "[abc]") "a") - (should-fail (&;regex "[abc]") "m"))) + (and (should-pass (&.regex "[abc]") "a") + (should-fail (&.regex "[abc]") "m"))) (test "Can parse using character ranges." - (and (should-pass (&;regex "[a-z]") "a") - (should-pass (&;regex "[a-z]") "m") - (should-pass (&;regex "[a-z]") "z"))) + (and (should-pass (&.regex "[a-z]") "a") + (should-pass (&.regex "[a-z]") "m") + (should-pass (&.regex "[a-z]") "z"))) (test "Can combine character ranges." - (and (should-pass (&;regex "[a-zA-Z]") "a") - (should-pass (&;regex "[a-zA-Z]") "m") - (should-pass (&;regex "[a-zA-Z]") "z") - (should-pass (&;regex "[a-zA-Z]") "A") - (should-pass (&;regex "[a-zA-Z]") "M") - (should-pass (&;regex "[a-zA-Z]") "Z"))) + (and (should-pass (&.regex "[a-zA-Z]") "a") + (should-pass (&.regex "[a-zA-Z]") "m") + (should-pass (&.regex "[a-zA-Z]") "z") + (should-pass (&.regex "[a-zA-Z]") "A") + (should-pass (&.regex "[a-zA-Z]") "M") + (should-pass (&.regex "[a-zA-Z]") "Z"))) )) (context: "Regular Expressions [Custom character classes : Part 2]" ($_ seq (test "Can negate custom character classes." - (and (should-fail (&;regex "[^abc]") "a") - (should-pass (&;regex "[^abc]") "m"))) + (and (should-fail (&.regex "[^abc]") "a") + (should-pass (&.regex "[^abc]") "m"))) (test "Can negate character ranges.." - (and (should-fail (&;regex "[^a-z]") "a") - (should-pass (&;regex "[^a-z]") "0"))) + (and (should-fail (&.regex "[^a-z]") "a") + (should-pass (&.regex "[^a-z]") "0"))) (test "Can parse negate combinations of character ranges." - (and (should-fail (&;regex "[^a-zA-Z]") "a") - (should-pass (&;regex "[^a-zA-Z]") "0"))) + (and (should-fail (&.regex "[^a-zA-Z]") "a") + (should-pass (&.regex "[^a-zA-Z]") "0"))) )) (context: "Regular Expressions [Custom character classes : Part 3]" ($_ seq (test "Can make custom character classes more specific." - (and (let [RE (&;regex "[a-z&&[def]]")] + (and (let [RE (&.regex "[a-z&&[def]]")] (and (should-fail RE "a") (should-pass RE "d"))) - (let [RE (&;regex "[a-z&&[^bc]]")] + (let [RE (&.regex "[a-z&&[^bc]]")] (and (should-pass RE "a") (should-fail RE "b"))) - (let [RE (&;regex "[a-z&&[^m-p]]")] + (let [RE (&.regex "[a-z&&[^m-p]]")] (and (should-pass RE "a") (should-fail RE "m") (should-fail RE "p"))))) )) (context: "Regular Expressions [Reference]" - (let [number (&;regex "\\d+")] + (let [number (&.regex "\\d+")] (test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\@<number>)-(\\@<number>)-(\\@<number>)") "809-345-6789")))) + (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\\@<number>)-(\\@<number>)-(\\@<number>)") "809-345-6789")))) (context: "Regular Expressions [Fuzzy Quantifiers]" ($_ seq (test "Can sequentially combine patterns." - (should-passT "aa" (&;regex "aa") "aa")) + (should-passT "aa" (&.regex "aa") "aa")) (test "Can match patterns optionally." - (and (should-passT "a" (&;regex "a?") "a") - (should-passT "" (&;regex "a?") ""))) + (and (should-passT "a" (&.regex "a?") "a") + (should-passT "" (&.regex "a?") ""))) (test "Can match a pattern 0 or more times." - (and (should-passT "aaa" (&;regex "a*") "aaa") - (should-passT "" (&;regex "a*") ""))) + (and (should-passT "aaa" (&.regex "a*") "aaa") + (should-passT "" (&.regex "a*") ""))) (test "Can match a pattern 1 or more times." - (and (should-passT "aaa" (&;regex "a+") "aaa") - (should-passT "a" (&;regex "a+") "a") - (should-fail (&;regex "a+") ""))) + (and (should-passT "aaa" (&.regex "a+") "aaa") + (should-passT "a" (&.regex "a+") "a") + (should-fail (&.regex "a+") ""))) )) (context: "Regular Expressions [Crisp Quantifiers]" ($_ seq (test "Can match a pattern N times." - (and (should-passT "aa" (&;regex "a{2}") "aa") - (should-passT "a" (&;regex "a{1}") "a") - (should-fail (&;regex "a{3}") "aa"))) + (and (should-passT "aa" (&.regex "a{2}") "aa") + (should-passT "a" (&.regex "a{1}") "a") + (should-fail (&.regex "a{3}") "aa"))) (test "Can match a pattern at-least N times." - (and (should-passT "aa" (&;regex "a{1,}") "aa") - (should-passT "aa" (&;regex "a{2,}") "aa") - (should-fail (&;regex "a{3,}") "aa"))) + (and (should-passT "aa" (&.regex "a{1,}") "aa") + (should-passT "aa" (&.regex "a{2,}") "aa") + (should-fail (&.regex "a{3,}") "aa"))) (test "Can match a pattern at-most N times." - (and (should-passT "aa" (&;regex "a{,2}") "aa") - (should-passT "aa" (&;regex "a{,3}") "aa"))) + (and (should-passT "aa" (&.regex "a{,2}") "aa") + (should-passT "aa" (&.regex "a{,3}") "aa"))) (test "Can match a pattern between N and M times." - (and (should-passT "a" (&;regex "a{1,2}") "a") - (should-passT "aa" (&;regex "a{1,2}") "aa"))) + (and (should-passT "a" (&.regex "a{1,2}") "a") + (should-passT "aa" (&.regex "a{1,2}") "aa"))) )) (context: "Regular Expressions [Groups]" ($_ seq (test "Can extract groups of sub-matches specified in a pattern." - (and (should-check ["abc" "b"] (&;regex "a(.)c") "abc") - (should-check ["abbbbbc" "bbbbb"] (&;regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (&;regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (&;regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (&;regex "(?<code>\\d{3})-\\k<code>-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (&;regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0") "809-809-6789-6789"))) + (and (should-check ["abc" "b"] (&.regex "a(.)c") "abc") + (should-check ["abbbbbc" "bbbbb"] (&.regex "a(b+)c") "abbbbbc") + (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-345-6789" "809" "6789"] (&.regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-809-6789" "809" "6789"] (&.regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789" "809" "6789"] (&.regex "(?<code>\\d{3})-\\k<code>-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0") "809-809-6789-6789"))) (test "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) + (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&.regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) )) (context: "Regular Expressions [Alternation]" ($_ seq (test "Can specify alternative patterns." - (and (should-check ["a" (+0 [])] (&;regex "a|b") "a") - (should-check ["b" (+1 [])] (&;regex "a|b") "b") - (should-fail (&;regex "a|b") "c"))) + (and (should-check ["a" (+0 [])] (&.regex "a|b") "a") + (should-check ["b" (+1 [])] (&.regex "a|b") "b") + (should-fail (&.regex "a|b") "c"))) (test "Can have groups within alternations." - (and (should-check ["abc" (+0 ["b" "c"])] (&;regex "a(.)(.)|b(.)(.)") "abc") - (should-check ["bcd" (+1 ["c" "d"])] (&;regex "a(.)(.)|b(.)(.)") "bcd") - (should-fail (&;regex "a(.)(.)|b(.)(.)") "cde") + (and (should-check ["abc" (+0 ["b" "c"])] (&.regex "a(.)(.)|b(.)(.)") "abc") + (should-check ["bcd" (+1 ["c" "d"])] (&.regex "a(.)(.)|b(.)(.)") "bcd") + (should-fail (&.regex "a(.)(.)|b(.)(.)") "cde") (should-check ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] - (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") + (&.regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") "809-345-6789"))) )) (context: "Pattern-matching" (<| (times +100) (do @ - [sample1 (r;text +3) - sample2 (r;text +3) - sample3 (r;text +4)] + [sample1 (r.text +3) + sample2 (r.text +3) + sample3 (r.text +4)] (case (format sample1 "-" sample2 "-" sample3) - (&;^regex "(.{3})-(.{3})-(.{4})" + (&.^regex "(.{3})-(.{3})-(.{4})" [_ match1 match2 match3]) (test "Can pattern-match using regular-expressions." (and (T/= sample1 match1) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index 7025bdc2a..4ed187c36 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -11,17 +11,17 @@ ["r" math/random]) lux/test) -(&;import (java/util/concurrent/Callable a)) +(&.import (java/util/concurrent/Callable a)) -(&;import java/lang/Exception +(&.import java/lang/Exception (new [String])) -(&;import java/lang/Object) +(&.import java/lang/Object) -(&;import (java/lang/Class a) +(&.import (java/lang/Class a) (getName [] String)) -(&;import java/lang/System +(&.import java/lang/System (#static out java/io/PrintStream) (#static currentTimeMillis [] #io long) (#static getenv [String] #io #? String)) @@ -62,7 +62,7 @@ (context: "Conversions" (<| (times +100) (do @ - [sample r;int] + [sample r.int] (with-expansions [<int-convs> (do-template [<to> <from> <message>] [(test <message> @@ -70,12 +70,12 @@ (let [capped-sample (|> sample <to> <from>)] (|> capped-sample <to> <from> (i/= capped-sample)))))] - [&;l2b &;b2l "Can succesfully convert to/from byte."] - [&;l2s &;s2l "Can succesfully convert to/from short."] - [&;l2i &;i2l "Can succesfully convert to/from int."] - [&;l2f &;f2l "Can succesfully convert to/from float."] - [&;l2d &;d2l "Can succesfully convert to/from double."] - [(<| &;i2c &;l2i) (<| &;i2l &;c2i) "Can succesfully convert to/from char."] + [&.l2b &.b2l "Can succesfully convert to/from byte."] + [&.l2s &.s2l "Can succesfully convert to/from short."] + [&.l2i &.i2l "Can succesfully convert to/from int."] + [&.l2f &.f2l "Can succesfully convert to/from float."] + [&.l2d &.d2l "Can succesfully convert to/from double."] + [(<| &.i2c &.l2i) (<| &.i2l &.c2i) "Can succesfully convert to/from char."] )] ($_ seq <int-convs> @@ -84,41 +84,41 @@ (context: "Miscellaneous" ($_ seq (test "Can check if an object is of a certain class." - (and (&;instance? String "") - (not (&;instance? Long "")) - (&;instance? Object "") - (not (&;instance? Object (&;null))))) + (and (&.instance? String "") + (not (&.instance? Long "")) + (&.instance? Object "") + (not (&.instance? Object (&.null))))) (test "Can run code in a \"synchronized\" block." - (&;synchronized "" true)) + (&.synchronized "" true)) (test "Can access Class instances." - (text/= "java.lang.Class" (Class::getName [] (&;class-for java/lang/Class)))) + (text/= "java.lang.Class" (Class::getName [] (&.class-for java/lang/Class)))) (test "Can check if a value is null." - (and (&;null? (&;null)) - (not (&;null? "")))) + (and (&.null? (&.null)) + (not (&.null? "")))) (test "Can safely convert nullable references into Maybe values." - (and (|> (: (Maybe Object) (&;??? (&;null))) - (case> #;None true + (and (|> (: (Maybe Object) (&.??? (&.null))) + (case> #.None true _ false)) - (|> (: (Maybe Object) (&;??? "")) - (case> (#;Some _) true + (|> (: (Maybe Object) (&.??? "")) + (case> (#.Some _) true _ false)))) )) (context: "Arrays" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) - idx (|> r;nat (:: @ map (n/% size))) - value r;int] + [size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +1)))) + idx (|> r.nat (:: @ map (n/% size))) + value r.int] ($_ seq (test "Can create arrays of some length." - (n/= size (&;array-length (&;array Long size)))) + (n/= size (&.array-length (&.array Long size)))) (test "Can set and get array values." - (let [arr (&;array Long size)] - (exec (&;array-write idx value arr) - (i/= value (&;array-read idx arr))))))))) + (let [arr (&.array Long size)] + (exec (&.array-write idx value arr) + (i/= value (&.array-read idx arr))))))))) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux index 30eda396f..20b3be116 100644 --- a/stdlib/test/test/lux/io.lux +++ b/stdlib/test/test/lux/io.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux ["&" io] (control ["M" monad #+ do Monad]) @@ -9,12 +9,12 @@ (context: "I/O" ($_ seq - (test "" (Text/= "YOLO" (&;run (&;io "YOLO")))) - (test "" (i/= 11 (&;run (:: &;Functor<IO> map i/inc (&;io 10))))) - (test "" (i/= 10 (&;run (:: &;Applicative<IO> wrap 10)))) - (test "" (i/= 30 (&;run (let [(^open "&/") &;Applicative<IO>] + (test "" (Text/= "YOLO" (&.run (&.io "YOLO")))) + (test "" (i/= 11 (&.run (:: &.Functor<IO> map i/inc (&.io 10))))) + (test "" (i/= 10 (&.run (:: &.Applicative<IO> wrap 10)))) + (test "" (i/= 30 (&.run (let [(^open "&/") &.Applicative<IO>] (&/apply (&/wrap (i/+ 10)) (&/wrap 20)))))) - (test "" (i/= 30 (&;run (do &;Monad<IO> + (test "" (i/= 30 (&.run (do &.Monad<IO> [f (wrap i/+) x (wrap 10) y (wrap 20)] diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux index cc1338374..eaba58d0f 100644 --- a/stdlib/test/test/lux/lang/syntax.lux +++ b/stdlib/test/test/lux/lang/syntax.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do]) @@ -16,62 +16,62 @@ (def: default-cursor Cursor - {#;module "" - #;line +0 - #;column +0}) + {#.module "" + #.line +0 + #.column +0}) (def: ident-part^ - (r;Random Text) - (do r;Monad<Random> + (r.Random Text) + (do r.Monad<Random> [#let [digits "0123456789" - delimiters "()[]{}#;\"" + delimiters "()[]{}#.\"" space "\t\v \n\r\f" invalid-range (format digits delimiters space) - char-gen (|> r;nat - (r;filter (function [sample] - (not (text;contains? (text;from-code sample) + char-gen (|> r.nat + (r.filter (function [sample] + (not (text.contains? (text.from-code sample) invalid-range)))))] - size (|> r;nat (:: @ map (|>> (n/% +20) (n/max +1))))] - (r;text' char-gen size))) + size (|> r.nat (:: @ map (|>> (n/% +20) (n/max +1))))] + (r.text' char-gen size))) (def: ident^ - (r;Random Ident) - (r;seq ident-part^ ident-part^)) + (r.Random Ident) + (r.seq ident-part^ ident-part^)) (def: code^ - (r;Random Code) - (let [numeric^ (: (r;Random Code) - ($_ r;either - (|> r;bool (r/map (|>> #;Bool [default-cursor]))) - (|> r;nat (r/map (|>> #;Nat [default-cursor]))) - (|> r;int (r/map (|>> #;Int [default-cursor]))) - (|> r;deg (r/map (|>> #;Deg [default-cursor]))) - (|> r;frac (r/map (|>> #;Frac [default-cursor]))))) - textual^ (: (r;Random Code) - ($_ r;either - (do r;Monad<Random> - [size (|> r;nat (r/map (n/% +20)))] - (|> (r;text size) (r/map (|>> #;Text [default-cursor])))) - (|> ident^ (r/map (|>> #;Symbol [default-cursor]))) - (|> ident^ (r/map (|>> #;Tag [default-cursor]))))) - simple^ (: (r;Random Code) - ($_ r;either + (r.Random Code) + (let [numeric^ (: (r.Random Code) + ($_ r.either + (|> r.bool (r/map (|>> #.Bool [default-cursor]))) + (|> r.nat (r/map (|>> #.Nat [default-cursor]))) + (|> r.int (r/map (|>> #.Int [default-cursor]))) + (|> r.deg (r/map (|>> #.Deg [default-cursor]))) + (|> r.frac (r/map (|>> #.Frac [default-cursor]))))) + textual^ (: (r.Random Code) + ($_ r.either + (do r.Monad<Random> + [size (|> r.nat (r/map (n/% +20)))] + (|> (r.text size) (r/map (|>> #.Text [default-cursor])))) + (|> ident^ (r/map (|>> #.Symbol [default-cursor]))) + (|> ident^ (r/map (|>> #.Tag [default-cursor]))))) + simple^ (: (r.Random Code) + ($_ r.either numeric^ textual^))] - (r;rec + (r.rec (function [code^] - (let [multi^ (do r;Monad<Random> - [size (|> r;nat (r/map (n/% +3)))] - (r;list size code^)) - composite^ (: (r;Random Code) - ($_ r;either - (|> multi^ (r/map (|>> #;Form [default-cursor]))) - (|> multi^ (r/map (|>> #;Tuple [default-cursor]))) - (do r;Monad<Random> - [size (|> r;nat (r/map (n/% +3)))] - (|> (r;list size (r;seq code^ code^)) - (r/map (|>> #;Record [default-cursor]))))))] - (r;either simple^ + (let [multi^ (do r.Monad<Random> + [size (|> r.nat (r/map (n/% +3)))] + (r.list size code^)) + composite^ (: (r.Random Code) + ($_ r.either + (|> multi^ (r/map (|>> #.Form [default-cursor]))) + (|> multi^ (r/map (|>> #.Tuple [default-cursor]))) + (do r.Monad<Random> + [size (|> r.nat (r/map (n/% +3)))] + (|> (r.list size (r.seq code^ code^)) + (r/map (|>> #.Record [default-cursor]))))))] + (r.either simple^ composite^)))))) (context: "Lux code syntax." @@ -82,29 +82,29 @@ other code^] ($_ seq (test "Can parse Lux code." - (case (&;read "" (dict;new text;Hash<Text>) - [default-cursor +0 (code;to-text sample)]) - (#e;Error error) + (case (&.read "" (dict.new text.Hash<Text>) + [default-cursor +0 (code.to-text sample)]) + (#e.Error error) false - (#e;Success [_ parsed]) - (:: code;Eq<Code> = parsed sample))) + (#e.Success [_ parsed]) + (:: code.Eq<Code> = parsed sample))) (test "Can parse Lux multiple code nodes." - (case (&;read "" (dict;new text;Hash<Text>) - [default-cursor +0 (format (code;to-text sample) " " - (code;to-text other))]) - (#e;Error error) + (case (&.read "" (dict.new text.Hash<Text>) + [default-cursor +0 (format (code.to-text sample) " " + (code.to-text other))]) + (#e.Error error) false - (#e;Success [remaining =sample]) - (case (&;read "" (dict;new text;Hash<Text>) + (#e.Success [remaining =sample]) + (case (&.read "" (dict.new text.Hash<Text>) remaining) - (#e;Error error) + (#e.Error error) false - (#e;Success [_ =other]) - (and (:: code;Eq<Code> = sample =sample) - (:: code;Eq<Code> = other =other))))) + (#e.Success [_ =other]) + (and (:: code.Eq<Code> = sample =sample) + (:: code.Eq<Code> = other =other))))) )))) (def: nat-to-frac @@ -114,18 +114,18 @@ (context: "Frac special syntax." (<| (times +100) (do @ - [numerator (|> r;nat (:: @ map (|>> (n/% +100) nat-to-frac))) - denominator (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1) nat-to-frac))) - signed? r;bool + [numerator (|> r.nat (:: @ map (|>> (n/% +100) nat-to-frac))) + denominator (|> r.nat (:: @ map (|>> (n/% +100) (n/max +1) nat-to-frac))) + signed? r.bool #let [expected (|> numerator (f// denominator) (f/* (if signed? -1.0 1.0)))]] (test "Can parse frac ratio syntax." - (case (&;read "" (dict;new text;Hash<Text>) + (case (&.read "" (dict.new text.Hash<Text>) [default-cursor +0 (format (if signed? "-" "") (%i (frac-to-int numerator)) "/" (%i (frac-to-int denominator)))]) - (#e;Success [_ [_ (#;Frac actual)]]) + (#e.Success [_ [_ (#.Frac actual)]]) (f/= expected actual) _ @@ -135,12 +135,12 @@ (context: "Nat special syntax." (<| (times +100) (do @ - [expected (|> r;nat (:: @ map (n/% +1_000)))] + [expected (|> r.nat (:: @ map (n/% +1_000)))] (test "Can parse nat char syntax." - (case (&;read "" (dict;new text;Hash<Text>) + (case (&.read "" (dict.new text.Hash<Text>) [default-cursor +0 - (format "#" (%t (text;from-code expected)) "")]) - (#e;Success [_ [_ (#;Nat actual)]]) + (format "#" (%t (text.from-code expected)) "")]) + (#e.Success [_ [_ (#.Nat actual)]]) (n/= expected actual) _ @@ -148,24 +148,24 @@ )))) (def: comment-text^ - (r;Random Text) - (let [char-gen (|> r;nat (r;filter (function [value] - (not (or (text;space? value) + (r.Random Text) + (let [char-gen (|> r.nat (r.filter (function [value] + (not (or (text.space? value) (n/= (char "#") value) (n/= (char "(") value) (n/= (char ")") value))))))] - (do r;Monad<Random> - [size (|> r;nat (r/map (n/% +20)))] - (r;text' char-gen size)))) + (do r.Monad<Random> + [size (|> r.nat (r/map (n/% +20)))] + (r.text' char-gen size)))) (def: comment^ - (r;Random Text) - (r;either (do r;Monad<Random> + (r.Random Text) + (r.either (do r.Monad<Random> [comment comment-text^] (wrap (format "## " comment "\n"))) - (r;rec (function [nested^] - (do r;Monad<Random> - [comment (r;either comment-text^ + (r.rec (function [nested^] + (do r.Monad<Random> + [comment (r.either comment-text^ nested^)] (wrap (format "#( " comment " )#"))))))) @@ -173,74 +173,74 @@ (<| (seed +6749851812188286456) ## (times +100) (do @ - [#let [char-gen (|> r;nat (r;filter (function [value] - (not (or (text;space? value) + [#let [char-gen (|> r.nat (r.filter (function [value] + (not (or (text.space? value) (n/= (char "\"") value))))))] x char-gen y char-gen z char-gen - offset-size (|> r;nat (r/map (|>> (n/% +10) (n/max +1)))) - #let [offset (text;join-with "" (list;repeat offset-size " "))] + offset-size (|> r.nat (r/map (|>> (n/% +10) (n/max +1)))) + #let [offset (text.join-with "" (list.repeat offset-size " "))] sample code^ comment comment^ unbalanced-comment comment-text^] ($_ seq (test "Will reject invalid multi-line text." - (let [bad-match (format (text;from-code x) "\n" - (text;from-code y) "\n" - (text;from-code z))] - (case (&;read "" (dict;new text;Hash<Text>) + (let [bad-match (format (text.from-code x) "\n" + (text.from-code y) "\n" + (text.from-code z))] + (case (&.read "" (dict.new text.Hash<Text>) [default-cursor +0 (format "\"" bad-match "\"")]) - (#e;Error error) + (#e.Error error) true - (#e;Success [_ parsed]) + (#e.Success [_ parsed]) false))) (test "Will accept valid multi-line text" - (let [good-input (format (text;from-code x) "\n" - offset (text;from-code y) "\n" - offset (text;from-code z)) - good-output (format (text;from-code x) "\n" - (text;from-code y) "\n" - (text;from-code z))] - (case (&;read "" (dict;new text;Hash<Text>) - [(|> default-cursor (update@ #;column (n/+ (n/dec offset-size)))) + (let [good-input (format (text.from-code x) "\n" + offset (text.from-code y) "\n" + offset (text.from-code z)) + good-output (format (text.from-code x) "\n" + (text.from-code y) "\n" + (text.from-code z))] + (case (&.read "" (dict.new text.Hash<Text>) + [(|> default-cursor (update@ #.column (n/+ (n/dec offset-size)))) +0 (format "\"" good-input "\"")]) - (#e;Error error) + (#e.Error error) false - (#e;Success [_ parsed]) - (:: code;Eq<Code> = + (#e.Success [_ parsed]) + (:: code.Eq<Code> = parsed - (code;text good-output))))) + (code.text good-output))))) (test "Can handle comments." - (case (&;read "" (dict;new text;Hash<Text>) + (case (&.read "" (dict.new text.Hash<Text>) [default-cursor +0 - (format comment (code;to-text sample))]) - (#e;Error error) + (format comment (code.to-text sample))]) + (#e.Error error) false - (#e;Success [_ parsed]) - (:: code;Eq<Code> = parsed sample))) + (#e.Success [_ parsed]) + (:: code.Eq<Code> = parsed sample))) (test "Will reject unbalanced multi-line comments." - (and (case (&;read "" (dict;new text;Hash<Text>) + (and (case (&.read "" (dict.new text.Hash<Text>) [default-cursor +0 (format "#(" "#(" unbalanced-comment ")#" - (code;to-text sample))]) - (#e;Error error) + (code.to-text sample))]) + (#e.Error error) true - (#e;Success [_ parsed]) + (#e.Success [_ parsed]) false) - (case (&;read "" (dict;new text;Hash<Text>) + (case (&.read "" (dict.new text.Hash<Text>) [default-cursor +0 (format "#(" unbalanced-comment ")#" ")#" - (code;to-text sample))]) - (#e;Error error) + (code.to-text sample))]) + (#e.Error error) true - (#e;Success [_ parsed]) + (#e.Success [_ parsed]) false))) )))) diff --git a/stdlib/test/test/lux/lang/type.lux b/stdlib/test/test/lux/lang/type.lux index 81a0a3cd9..3adc4d43d 100644 --- a/stdlib/test/test/lux/lang/type.lux +++ b/stdlib/test/test/lux/lang/type.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control ["M" monad #+ do Monad] @@ -14,33 +14,33 @@ ## [Utils] (def: gen-name - (r;Random Text) - (do r;Monad<Random> - [size (|> r;nat (:: @ map (n/% +10)))] - (r;text size))) + (r.Random Text) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (n/% +10)))] + (r.text size))) (def: gen-ident - (r;Random Ident) - (r;seq gen-name gen-name)) + (r.Random Ident) + (r.seq gen-name gen-name)) (def: gen-type - (r;Random Type) - (let [(^open "R/") r;Monad<Random>] - (r;rec (function [gen-type] - ($_ r;alt - (r;seq gen-name (R/wrap (list))) + (r.Random Type) + (let [(^open "R/") r.Monad<Random>] + (r.rec (function [gen-type] + ($_ r.alt + (r.seq gen-name (R/wrap (list))) (R/wrap []) (R/wrap []) - (r;seq gen-type gen-type) - (r;seq gen-type gen-type) - (r;seq gen-type gen-type) - r;nat - r;nat - r;nat - (r;seq (R/wrap (list)) gen-type) - (r;seq (R/wrap (list)) gen-type) - (r;seq gen-type gen-type) - (r;seq gen-ident gen-type) + (r.seq gen-type gen-type) + (r.seq gen-type gen-type) + (r.seq gen-type gen-type) + r.nat + r.nat + r.nat + (r.seq (R/wrap (list)) gen-type) + (r.seq (R/wrap (list)) gen-type) + (r.seq gen-type gen-type) + (r.seq gen-ident gen-type) ))))) ## [Tests] @@ -49,53 +49,53 @@ (do @ [sample gen-type] (test "Every type is equal to itself." - (:: &;Eq<Type> = sample sample))))) + (:: &.Eq<Type> = sample sample))))) (context: "Type application" (test "Can apply quantified types (universal and existential quantification)." - (and (maybe;default false - (do maybe;Monad<Maybe> - [partial (&;apply (list Bool) Ann) - full (&;apply (list Int) partial)] - (wrap (:: &;Eq<Type> = full (#;Product Bool Int))))) - (|> (&;apply (list Bool) Text) - (case> #;None true _ false))))) + (and (maybe.default false + (do maybe.Monad<Maybe> + [partial (&.apply (list Bool) Ann) + full (&.apply (list Int) partial)] + (wrap (:: &.Eq<Type> = full (#.Product Bool Int))))) + (|> (&.apply (list Bool) Text) + (case> #.None true _ false))))) (context: "Naming" - (let [base (#;Named ["" "a"] (#;Product Bool Int)) - aliased (#;Named ["" "c"] - (#;Named ["" "b"] + (let [base (#.Named ["" "a"] (#.Product Bool Int)) + aliased (#.Named ["" "c"] + (#.Named ["" "b"] base))] ($_ seq (test "Can remove aliases from an already-named type." - (:: &;Eq<Type> = + (:: &.Eq<Type> = base - (&;un-alias aliased))) + (&.un-alias aliased))) (test "Can remove all names from a type." - (and (not (:: &;Eq<Type> = + (and (not (:: &.Eq<Type> = base - (&;un-name aliased))) - (:: &;Eq<Type> = - (&;un-name base) - (&;un-name aliased))))))) + (&.un-name aliased))) + (:: &.Eq<Type> = + (&.un-name base) + (&.un-name aliased))))))) (context: "Type construction [structs]" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (n/% +3))) + [size (|> r.nat (:: @ map (n/% +3))) members (|> gen-type - (r;filter (function [type] + (r.filter (function [type] (case type - (^or (#;Sum _) (#;Product _)) + (^or (#.Sum _) (#.Product _)) false _ true))) - (list;repeat size) - (M;seq @)) - #let [(^open "&/") &;Eq<Type> - (^open "L/") (list;Eq<List> &;Eq<Type>)]] + (list.repeat size) + (M.seq @)) + #let [(^open "&/") &.Eq<Type> + (^open "L/") (list.Eq<List> &.Eq<Type>)]] (with-expansions [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>] [(test (format "Can build and tear-down " <desc> " types.") @@ -104,8 +104,8 @@ (and (L/= (list) members) (L/= (list <unit>) flat)))))] - ["variant" &;variant &;flatten-variant Void] - ["tuple" &;tuple &;flatten-tuple Unit] + ["variant" &.variant &.flatten-variant Void] + ["tuple" &.tuple &.flatten-tuple Unit] )] ($_ seq <struct-tests> @@ -114,42 +114,42 @@ (context: "Type construction [parameterized]" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (n/% +3))) - members (M;seq @ (list;repeat size gen-type)) + [size (|> r.nat (:: @ map (n/% +3))) + members (M.seq @ (list.repeat size gen-type)) extra (|> gen-type - (r;filter (function [type] + (r.filter (function [type] (case type - (^or (#;Function _) (#;Apply _)) + (^or (#.Function _) (#.Apply _)) false _ true)))) - #let [(^open "&/") &;Eq<Type> - (^open "L/") (list;Eq<List> &;Eq<Type>)]] + #let [(^open "&/") &.Eq<Type> + (^open "L/") (list.Eq<List> &.Eq<Type>)]] ($_ seq (test "Can build and tear-down function types." - (let [[inputs output] (|> (&;function members extra) &;flatten-function)] + (let [[inputs output] (|> (&.function members extra) &.flatten-function)] (and (L/= members inputs) (&/= extra output)))) (test "Can build and tear-down application types." - (let [[tfunc tparams] (|> extra (&;application members) &;flatten-application)] - (n/= (list;size members) (list;size tparams)))) + (let [[tfunc tparams] (|> extra (&.application members) &.flatten-application)] + (n/= (list.size members) (list.size tparams)))) )))) (context: "Type construction [higher order]" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (n/% +3))) + [size (|> r.nat (:: @ map (n/% +3))) extra (|> gen-type - (r;filter (function [type] + (r.filter (function [type] (case type - (^or (#;UnivQ _) (#;ExQ _)) + (^or (#.UnivQ _) (#.ExQ _)) false _ true)))) - #let [(^open "&/") &;Eq<Type>]] + #let [(^open "&/") &.Eq<Type>]] (with-expansions [<quant-tests> (do-template [<desc> <ctor> <dtor>] [(test (format "Can build and tear-down " <desc> " types.") @@ -157,8 +157,8 @@ (and (n/= size flat-size) (&/= extra flat-body))))] - ["universally-quantified" &;univ-q &;flatten-univ-q] - ["existentially-quantified" &;ex-q &;flatten-ex-q] + ["universally-quantified" &.univ-q &.flatten-univ-q] + ["existentially-quantified" &.ex-q &.flatten-ex-q] )] ($_ seq <quant-tests> diff --git a/stdlib/test/test/lux/lang/type/check.lux b/stdlib/test/test/lux/lang/type/check.lux index 188c73823..d63444b52 100644 --- a/stdlib/test/test/lux/lang/type/check.lux +++ b/stdlib/test/test/lux/lang/type/check.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -17,111 +17,111 @@ ## [Utils] (def: gen-name - (r;Random Text) - (do r;Monad<Random> - [size (|> r;nat (:: @ map (n/% +10)))] - (r;text size))) + (r.Random Text) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (n/% +10)))] + (r.text size))) (def: gen-ident - (r;Random Ident) - (r;seq gen-name gen-name)) + (r.Random Ident) + (r.seq gen-name gen-name)) (def: gen-type - (r;Random Type) - (let [(^open "r/") r;Monad<Random>] - (r;rec (function [gen-type] - ($_ r;alt - (r;seq gen-name (r/wrap (list))) + (r.Random Type) + (let [(^open "r/") r.Monad<Random>] + (r.rec (function [gen-type] + ($_ r.alt + (r.seq gen-name (r/wrap (list))) (r/wrap []) (r/wrap []) - (r;seq gen-type gen-type) - (r;seq gen-type gen-type) - (r;seq gen-type gen-type) - r;nat - r;nat - r;nat - (r;seq (r/wrap (list)) gen-type) - (r;seq (r/wrap (list)) gen-type) - (r;seq gen-type gen-type) - (r;seq gen-ident gen-type) + (r.seq gen-type gen-type) + (r.seq gen-type gen-type) + (r.seq gen-type gen-type) + r.nat + r.nat + r.nat + (r.seq (r/wrap (list)) gen-type) + (r.seq (r/wrap (list)) gen-type) + (r.seq gen-type gen-type) + (r.seq gen-ident gen-type) ))))) (def: (valid-type? type) (-> Type Bool) (case type - (#;Primitive name params) - (list;every? valid-type? params) + (#.Primitive name params) + (list.every? valid-type? params) - (^or #;Void #;Unit (#;Ex id)) + (^or #.Void #.Unit (#.Ex id)) true (^template [<tag>] (<tag> left right) (and (valid-type? left) (valid-type? right))) - ([#;Sum] [#;Product] [#;Function]) + ([#.Sum] [#.Product] [#.Function]) - (#;Named name type') + (#.Named name type') (valid-type? type') _ false)) (def: (type-checks? input) - (-> (@;Check []) Bool) - (case (@;run @;fresh-context input) - (#;Right []) + (-> (@.Check []) Bool) + (case (@.run @.fresh-context input) + (#.Right []) true - (#;Left error) + (#.Left error) false)) ## [Tests] (context: "Top and Bottom." (<| (times +100) (do @ - [sample (|> gen-type (r;filter valid-type?))] + [sample (|> gen-type (r.filter valid-type?))] ($_ seq (test "Top is the super-type of everything." - (@;checks? Top sample)) + (@.checks? Top sample)) (test "Bottom is the sub-type of everything." - (@;checks? sample Bottom)) + (@.checks? sample Bottom)) )))) (context: "Simple type-checking." ($_ seq (test "Unit and Void match themselves." - (and (@;checks? Void Void) - (@;checks? Unit Unit))) + (and (@.checks? Void Void) + (@.checks? Unit Unit))) (test "Existential types only match with themselves." - (and (type-checks? (do @;Monad<Check> - [[_ exT] @;existential] - (@;check exT exT))) - (not (type-checks? (do @;Monad<Check> - [[_ exTL] @;existential - [_ exTR] @;existential] - (@;check exTL exTR)))))) + (and (type-checks? (do @.Monad<Check> + [[_ exT] @.existential] + (@.check exT exT))) + (not (type-checks? (do @.Monad<Check> + [[_ exTL] @.existential + [_ exTR] @.existential] + (@.check exTL exTR)))))) (test "Names do not affect type-checking." - (and (type-checks? (do @;Monad<Check> - [[_ exT] @;existential] - (@;check (#;Named ["module" "name"] exT) + (and (type-checks? (do @.Monad<Check> + [[_ exT] @.existential] + (@.check (#.Named ["module" "name"] exT) exT))) - (type-checks? (do @;Monad<Check> - [[_ exT] @;existential] - (@;check exT - (#;Named ["module" "name"] exT)))) - (type-checks? (do @;Monad<Check> - [[_ exT] @;existential] - (@;check (#;Named ["module" "name"] exT) - (#;Named ["module" "name"] exT)))))) + (type-checks? (do @.Monad<Check> + [[_ exT] @.existential] + (@.check exT + (#.Named ["module" "name"] exT)))) + (type-checks? (do @.Monad<Check> + [[_ exT] @.existential] + (@.check (#.Named ["module" "name"] exT) + (#.Named ["module" "name"] exT)))))) (test "Functions are covariant on inputs and contravariant on outputs." - (and (@;checks? (#;Function Bottom Top) - (#;Function Top Bottom)) - (not (@;checks? (#;Function Top Bottom) - (#;Function Bottom Top))))) + (and (@.checks? (#.Function Bottom Top) + (#.Function Top Bottom)) + (not (@.checks? (#.Function Top Bottom) + (#.Function Bottom Top))))) )) (context: "Type application." @@ -130,74 +130,74 @@ [meta gen-type data gen-type] (test "Can type-check type application." - (and (@;checks? (|> Ann (#;Apply meta) (#;Apply data)) - (type;tuple (list meta data))) - (@;checks? (type;tuple (list meta data)) - (|> Ann (#;Apply meta) (#;Apply data)))))))) + (and (@.checks? (|> Ann (#.Apply meta) (#.Apply data)) + (type.tuple (list meta data))) + (@.checks? (type.tuple (list meta data)) + (|> Ann (#.Apply meta) (#.Apply data)))))))) (context: "Primitive types." (<| (times +100) (do @ [nameL gen-name - nameR (|> gen-name (r;filter (|>> (text/= nameL) not))) + nameR (|> gen-name (r.filter (|>> (text/= nameL) not))) paramL gen-type - paramR (|> gen-type (r;filter (|>> (@;checks? paramL) not)))] + paramR (|> gen-type (r.filter (|>> (@.checks? paramL) not)))] ($_ seq (test "Primitive types match when they have the same name and the same parameters." - (@;checks? (#;Primitive nameL (list paramL)) - (#;Primitive nameL (list paramL)))) + (@.checks? (#.Primitive nameL (list paramL)) + (#.Primitive nameL (list paramL)))) (test "Names matter to primitive types." - (not (@;checks? (#;Primitive nameL (list paramL)) - (#;Primitive nameR (list paramL))))) + (not (@.checks? (#.Primitive nameL (list paramL)) + (#.Primitive nameR (list paramL))))) (test "Parameters matter to primitive types." - (not (@;checks? (#;Primitive nameL (list paramL)) - (#;Primitive nameL (list paramR))))) + (not (@.checks? (#.Primitive nameL (list paramL)) + (#.Primitive nameL (list paramR))))) )))) (context: "Type variables." ($_ seq (test "Type-vars check against themselves." - (type-checks? (do @;Monad<Check> - [[id var] @;var] - (@;check var var)))) + (type-checks? (do @.Monad<Check> + [[id var] @.var] + (@.check var var)))) (test "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (do @;Monad<Check> - [[id var] @;var] - (@;check var #;Unit))) - (type-checks? (do @;Monad<Check> - [[id var] @;var] - (@;check #;Unit var))))) + (and (type-checks? (do @.Monad<Check> + [[id var] @.var] + (@.check var #.Unit))) + (type-checks? (do @.Monad<Check> + [[id var] @.var] + (@.check #.Unit var))))) (test "Cannot rebind already bound type-vars." - (not (type-checks? (do @;Monad<Check> - [[id var] @;var - _ (@;check var #;Unit)] - (@;check var #;Void))))) + (not (type-checks? (do @.Monad<Check> + [[id var] @.var + _ (@.check var #.Unit)] + (@.check var #.Void))))) (test "If the type bound to a var is a super-type to another, then the var is also a super-type." - (type-checks? (do @;Monad<Check> - [[id var] @;var - _ (@;check var Top)] - (@;check var #;Unit)))) + (type-checks? (do @.Monad<Check> + [[id var] @.var + _ (@.check var Top)] + (@.check var #.Unit)))) (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type." - (type-checks? (do @;Monad<Check> - [[id var] @;var - _ (@;check var Bottom)] - (@;check #;Unit var)))) + (type-checks? (do @.Monad<Check> + [[id var] @.var + _ (@.check var Bottom)] + (@.check #.Unit var)))) )) (def: (build-ring num-connections) - (-> Nat (@;Check [[Nat Type] (List [Nat Type]) [Nat Type]])) - (do @;Monad<Check> - [[head-id head-type] @;var - ids+types (monad;seq @ (list;repeat num-connections @;var)) - [tail-id tail-type] (monad;fold @ (function [[tail-id tail-type] [_head-id _head-type]] + (-> Nat (@.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) + (do @.Monad<Check> + [[head-id head-type] @.var + ids+types (monad.seq @ (list.repeat num-connections @.var)) + [tail-id tail-type] (monad.fold @ (function [[tail-id tail-type] [_head-id _head-type]] (do @ - [_ (@;check head-type tail-type)] + [_ (@.check head-type tail-type)] (wrap [tail-id tail-type]))) [head-id head-type] ids+types)] @@ -206,57 +206,57 @@ (context: "Rings of type variables." (<| (times +100) (do @ - [num-connections (|> r;nat (:: @ map (n/% +100))) - boundT (|> gen-type (r;filter (|>> (case> (#;Var _) false _ true)))) - pick-pcg (r;seq r;nat r;nat)] + [num-connections (|> r.nat (:: @ map (n/% +100))) + boundT (|> gen-type (r.filter (|>> (case> (#.Var _) false _ true)))) + pick-pcg (r.seq r.nat r.nat)] ($_ seq (test "Can create rings of variables." - (type-checks? (do @;Monad<Check> + (type-checks? (do @.Monad<Check> [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections) - #let [ids (list/map product;left ids+types)] - headR (@;ring head-id) - tailR (@;ring tail-id)] - (@;assert "" - (let [same-rings? (:: set;Eq<Set> = headR tailR) - expected-size? (n/= (n/inc num-connections) (set;size headR)) - same-vars? (|> (set;to-list headR) - (list;sort n/<) - (:: (list;Eq<List> number;Eq<Nat>) = (list;sort n/< (#;Cons head-id ids))))] + #let [ids (list/map product.left ids+types)] + headR (@.ring head-id) + tailR (@.ring tail-id)] + (@.assert "" + (let [same-rings? (:: set.Eq<Set> = headR tailR) + expected-size? (n/= (n/inc num-connections) (set.size headR)) + same-vars? (|> (set.to-list headR) + (list.sort n/<) + (:: (list.Eq<List> number.Eq<Nat>) = (list.sort n/< (#.Cons head-id ids))))] (and same-rings? expected-size? same-vars?)))))) (test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do @;Monad<Check> + (type-checks? (do @.Monad<Check> [[[head-id headT] ids+types tailT] (build-ring num-connections) - #let [ids (list/map product;left ids+types)] - _ (@;check headT boundT) - head-bound (@;read head-id) - tail-bound (monad;map @ @;read ids) - headR (@;ring head-id) - tailR+ (monad;map @ @;ring ids)] - (let [rings-were-erased? (and (set;empty? headR) - (list;every? set;empty? tailR+)) - same-types? (list;every? (type/= boundT) (list& (maybe;default headT head-bound) + #let [ids (list/map product.left ids+types)] + _ (@.check headT boundT) + head-bound (@.read head-id) + tail-bound (monad.map @ @.read ids) + headR (@.ring head-id) + tailR+ (monad.map @ @.ring ids)] + (let [rings-were-erased? (and (set.empty? headR) + (list.every? set.empty? tailR+)) + same-types? (list.every? (type/= boundT) (list& (maybe.default headT head-bound) (list/map (function [[tail-id ?tailT]] - (maybe;default (#;Var tail-id) ?tailT)) - (list;zip2 ids tail-bound))))] - (@;assert "" + (maybe.default (#.Var tail-id) ?tailT)) + (list.zip2 ids tail-bound))))] + (@.assert "" (and rings-were-erased? same-types?)))))) (test "Can merge multiple rings of variables." - (type-checks? (do @;Monad<Check> + (type-checks? (do @.Monad<Check> [[[head-idL headTL] ids+typesL [tail-idL tailTL]] (build-ring num-connections) [[head-idR headTR] ids+typesR [tail-idR tailTR]] (build-ring num-connections) - headRL-pre (@;ring head-idL) - headRR-pre (@;ring head-idR) - _ (@;check headTL headTR) - headRL-post (@;ring head-idL) - headRR-post (@;ring head-idR)] - (@;assert "" - (let [same-rings? (:: set;Eq<Set> = headRL-post headRR-post) + headRL-pre (@.ring head-idL) + headRR-pre (@.ring head-idR) + _ (@.check headTL headTR) + headRL-post (@.ring head-idL) + headRR-post (@.ring head-idR)] + (@.assert "" + (let [same-rings? (:: set.Eq<Set> = headRL-post headRR-post) expected-size? (n/= (n/* +2 (n/inc num-connections)) - (set;size headRL-post)) - union? (:: set;Eq<Set> = headRL-post (set;union headRL-pre headRR-pre))] + (set.size headRL-post)) + union? (:: set.Eq<Set> = headRL-post (set.union headRL-pre headRR-pre))] (and same-rings? expected-size? union?)))))) diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux index 64bdf5f1c..08160c7e2 100644 --- a/stdlib/test/test/lux/macro/code.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -13,20 +13,20 @@ (with-expansions [<tests> (do-template [<expr> <text>] [(test (format "Can produce Code node: " <text>) - (and (T/= <text> (&;to-text <expr>)) - (:: &;Eq<Code> = <expr> <expr>)))] + (and (T/= <text> (&.to-text <expr>)) + (:: &.Eq<Code> = <expr> <expr>)))] - [(&;bool true) "true"] - [(&;bool false) "false"] - [(&;int 123) "123"] - [(&;frac 123.0) "123.0"] - [(&;text "\n") "\"\\n\""] - [(&;tag ["yolo" "lol"]) "#yolo;lol"] - [(&;symbol ["yolo" "lol"]) "yolo;lol"] - [(&;form (list (&;bool true) (&;int 123))) "(true 123)"] - [(&;tuple (list (&;bool true) (&;int 123))) "[true 123]"] - [(&;record (list [(&;bool true) (&;int 123)])) "{true 123}"] - [(&;local-tag "lol") "#lol"] - [(&;local-symbol "lol") "lol"] + [(&.bool true) "true"] + [(&.bool false) "false"] + [(&.int 123) "123"] + [(&.frac 123.0) "123.0"] + [(&.text "\n") "\"\\n\""] + [(&.tag ["yolo" "lol"]) "#yolo.lol"] + [(&.symbol ["yolo" "lol"]) "yolo.lol"] + [(&.form (list (&.bool true) (&.int 123))) "(true 123)"] + [(&.tuple (list (&.bool true) (&.int 123))) "[true 123]"] + [(&.record (list [(&.bool true) (&.int 123)])) "{true 123}"] + [(&.local-tag "lol") "#lol"] + [(&.local-symbol "lol") "lol"] )] ($_ seq <tests>))) diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index bd3239cf6..8867732c0 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -38,29 +38,29 @@ #recursive Recursive}) (def: gen-recursive - (r;Random Recursive) - (r;rec (function [gen-recursive] - (r;alt r;frac - (r;seq r;frac gen-recursive))))) + (r.Random Recursive) + (r.rec (function [gen-recursive] + (r.alt r.frac + (r.seq r.frac gen-recursive))))) (def: gen-record - (r;Random Record) - (do r;Monad<Random> - [size (:: @ map (n/% +2) r;nat) - #let [gen-int (|> r;int (:: @ map (|>> int/abs (i/% 1_000_000))))]] - ($_ r;seq + (r.Random Record) + (do r.Monad<Random> + [size (:: @ map (n/% +2) r.nat) + #let [gen-int (|> r.int (:: @ map (|>> int/abs (i/% 1_000_000))))]] + ($_ r.seq (:: @ wrap []) - r;bool + r.bool gen-int - r;frac - (r;text size) - (r;maybe gen-int) - (r;list size gen-int) - ($_ r;alt r;bool gen-int r;frac) - ($_ r;seq gen-int r;frac (r;text size)) + r.frac + (r.text size) + (r.maybe gen-int) + (r.list size gen-int) + ($_ r.alt r.bool gen-int r.frac) + ($_ r.seq gen-int r.frac (r.text size)) gen-recursive))) -(derived: (&;Eq<?> Record)) +(derived: (&.Eq<?> Record)) ## [Tests] (context: "Eq polytypism" diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux index d1c42cde5..3cb6653a5 100644 --- a/stdlib/test/test/lux/macro/poly/functor.lux +++ b/stdlib/test/test/lux/macro/poly/functor.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -17,13 +17,13 @@ lux/test) ## [Utils] -(derived: (&;Functor<?> ;Maybe)) +(derived: (&.Functor<?> .Maybe)) -(derived: (&;Functor<?> ;List)) +(derived: (&.Functor<?> .List)) -(derived: (&;Functor<?> state;State)) +(derived: (&.Functor<?> state.State)) -(derived: (&;Functor<?> identity;Identity)) +(derived: (&.Functor<?> identity.Identity)) ## [Tests] (context: "Functor polytypism." diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index b159bf999..f53af1cb7 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -19,8 +19,8 @@ ## [Utils] (def: (enforced? parser input) (-> (Syntax []) (List Code) Bool) - (case (p;run input parser) - (#;Right [_ []]) + (case (p.run input parser) + (#.Right [_ []]) true _ @@ -28,8 +28,8 @@ (def: (found? parser input) (-> (Syntax Bool) (List Code) Bool) - (case (p;run input parser) - (#;Right [_ true]) + (case (p.run input parser) + (#.Right [_ true]) true _ @@ -37,17 +37,17 @@ (def: (is? Eq<a> test parser input) (All [a] (-> (Eq a) a (Syntax a) (List Code) Bool)) - (case (p;run input parser) - (#;Right [_ output]) + (case (p.run input parser) + (#.Right [_ output]) (:: Eq<a> = test output) _ false)) (def: (fails? input) - (All [a] (-> (E;Error a) Bool)) + (All [a] (-> (E.Error a) Bool)) (case input - (#;Left _) + (#.Left _) true _ @@ -55,7 +55,7 @@ (syntax: (match pattern input) (wrap (list (` (case (~ input) - (^ (#;Right [(~' _) (~ pattern)])) + (^ (#.Right [(~' _) (~ pattern)])) true (~' _) @@ -67,34 +67,34 @@ [<simple-tests> (do-template [<assertion> <value> <ctor> <Eq> <get>] [(test <assertion> (and (is? <Eq> <value> <get> (list (<ctor> <value>))) - (found? (s;this? (<ctor> <value>)) (list (<ctor> <value>))) - (enforced? (s;this (<ctor> <value>)) (list (<ctor> <value>)))))] - - ["Can parse Bool syntax." true code;bool bool;Eq<Bool> s;bool] - ["Can parse Nat syntax." +123 code;nat number;Eq<Nat> s;nat] - ["Can parse Int syntax." 123 code;int number;Eq<Int> s;int] - ["Can parse Deg syntax." .123 code;deg number;Eq<Deg> s;deg] - ["Can parse Frac syntax." 123.0 code;frac number;Eq<Frac> s;frac] - ["Can parse Text syntax." "\n" code;text text;Eq<Text> s;text] - ["Can parse Symbol syntax." ["yolo" "lol"] code;symbol ident;Eq<Ident> s;symbol] - ["Can parse Tag syntax." ["yolo" "lol"] code;tag ident;Eq<Ident> s;tag] + (found? (s.this? (<ctor> <value>)) (list (<ctor> <value>))) + (enforced? (s.this (<ctor> <value>)) (list (<ctor> <value>)))))] + + ["Can parse Bool syntax." true code.bool bool.Eq<Bool> s.bool] + ["Can parse Nat syntax." +123 code.nat number.Eq<Nat> s.nat] + ["Can parse Int syntax." 123 code.int number.Eq<Int> s.int] + ["Can parse Deg syntax." .123 code.deg number.Eq<Deg> s.deg] + ["Can parse Frac syntax." 123.0 code.frac number.Eq<Frac> s.frac] + ["Can parse Text syntax." "\n" code.text text.Eq<Text> s.text] + ["Can parse Symbol syntax." ["yolo" "lol"] code.symbol ident.Eq<Ident> s.symbol] + ["Can parse Tag syntax." ["yolo" "lol"] code.tag ident.Eq<Ident> s.tag] )] ($_ seq <simple-tests> (test "Can parse symbols belonging to the current namespace." (and (match "yolo" - (p;run (list (code;local-symbol "yolo")) - s;local-symbol)) - (fails? (p;run (list (code;symbol ["yolo" "lol"])) - s;local-symbol)))) + (p.run (list (code.local-symbol "yolo")) + s.local-symbol)) + (fails? (p.run (list (code.symbol ["yolo" "lol"])) + s.local-symbol)))) (test "Can parse tags belonging to the current namespace." (and (match "yolo" - (p;run (list (code;local-tag "yolo")) - s;local-tag)) - (fails? (p;run (list (code;tag ["yolo" "lol"])) - s;local-tag)))) + (p.run (list (code.local-tag "yolo")) + s.local-tag)) + (fails? (p.run (list (code.tag ["yolo" "lol"])) + s.local-tag)))) ))) (context: "Complex value syntax." @@ -102,52 +102,52 @@ [<group-tests> (do-template [<type> <parser> <ctor>] [(test (format "Can parse " <type> " syntax.") (and (match [true 123] - (p;run (list (<ctor> (list (code;bool true) (code;int 123)))) - (<parser> (p;seq s;bool s;int)))) + (p.run (list (<ctor> (list (code.bool true) (code.int 123)))) + (<parser> (p.seq s.bool s.int)))) (match true - (p;run (list (<ctor> (list (code;bool true)))) - (<parser> s;bool))) - (fails? (p;run (list (<ctor> (list (code;bool true) (code;int 123)))) - (<parser> s;bool))) - (match (#;Left true) - (p;run (list (<ctor> (list (code;bool true)))) - (<parser> (p;alt s;bool s;int)))) - (match (#;Right 123) - (p;run (list (<ctor> (list (code;int 123)))) - (<parser> (p;alt s;bool s;int)))) - (fails? (p;run (list (<ctor> (list (code;frac 123.0)))) - (<parser> (p;alt s;bool s;int))))))] - - ["form" s;form code;form] - ["tuple" s;tuple code;tuple])] + (p.run (list (<ctor> (list (code.bool true)))) + (<parser> s.bool))) + (fails? (p.run (list (<ctor> (list (code.bool true) (code.int 123)))) + (<parser> s.bool))) + (match (#.Left true) + (p.run (list (<ctor> (list (code.bool true)))) + (<parser> (p.alt s.bool s.int)))) + (match (#.Right 123) + (p.run (list (<ctor> (list (code.int 123)))) + (<parser> (p.alt s.bool s.int)))) + (fails? (p.run (list (<ctor> (list (code.frac 123.0)))) + (<parser> (p.alt s.bool s.int))))))] + + ["form" s.form code.form] + ["tuple" s.tuple code.tuple])] ($_ seq <group-tests> (test "Can parse record syntax." (match [true 123] - (p;run (list (code;record (list [(code;bool true) (code;int 123)]))) - (s;record (p;seq s;bool s;int))))) + (p.run (list (code.record (list [(code.bool true) (code.int 123)]))) + (s.record (p.seq s.bool s.int))))) ))) (context: "Combinators" ($_ seq (test "Can parse any Code." - (match [_ (#;Bool true)] - (p;run (list (code;bool true) (code;int 123)) - s;any))) + (match [_ (#.Bool true)] + (p.run (list (code.bool true) (code.int 123)) + s.any))) (test "Can check whether the end has been reached." (and (match true - (p;run (list) - s;end?)) + (p.run (list) + s.end?)) (match false - (p;run (list (code;bool true)) - s;end?)))) + (p.run (list (code.bool true)) + s.end?)))) (test "Can ensure the end has been reached." (and (match [] - (p;run (list) - s;end!)) - (fails? (p;run (list (code;bool true)) - s;end!)))) + (p.run (list) + s.end!)) + (fails? (p.run (list (code.bool true)) + s.end!)))) )) diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 3852ace0d..3dda899c5 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -18,53 +18,53 @@ (context: "Trigonometry" (<| (seed +4611737486687492590) (do @ - [angle (|> r;frac (:: @ map (f/* &;tau)))] + [angle (|> r.frac (:: @ map (f/* &.tau)))] ($_ seq (test "Sine and arc-sine are inverse functions." - (|> angle &;sin &;asin (within? margin angle))) + (|> angle &.sin &.asin (within? margin angle))) (test "Cosine and arc-cosine are inverse functions." - (|> angle &;cos &;acos (within? margin angle))) + (|> angle &.cos &.acos (within? margin angle))) (test "Tangent and arc-tangent are inverse functions." - (|> angle &;tan &;atan (within? margin angle))) + (|> angle &.tan &.atan (within? margin angle))) )))) (context: "Roots" (<| (times +100) (do @ - [factor (|> r;nat (:: @ map (|>> (n/% +1000) + [factor (|> r.nat (:: @ map (|>> (n/% +1000) (n/max +1) nat-to-int int-to-frac))) - base (|> r;frac (:: @ map (f/* factor)))] + base (|> r.frac (:: @ map (f/* factor)))] ($_ seq (test "Square-root is inverse of square." - (|> base (&;pow 2.0) &;root2 (f/= base))) + (|> base (&.pow 2.0) &.root2 (f/= base))) (test "Cubic-root is inverse of cube." - (|> base (&;pow 3.0) &;root3 (f/= base))) + (|> base (&.pow 3.0) &.root3 (f/= base))) )))) (context: "Rounding" (<| (times +100) (do @ - [sample (|> r;frac (:: @ map (f/* 1000.0)))] + [sample (|> r.frac (:: @ map (f/* 1000.0)))] ($_ seq (test "The ceiling will be an integer value, and will be >= the original." - (let [ceil'd (&;ceil sample)] + (let [ceil'd (&.ceil sample)] (and (|> ceil'd frac-to-int int-to-frac (f/= ceil'd)) (f/>= sample ceil'd) (f/<= 1.0 (f/- sample ceil'd))))) (test "The floor will be an integer value, and will be <= the original." - (let [floor'd (&;floor sample)] + (let [floor'd (&.floor sample)] (and (|> floor'd frac-to-int int-to-frac (f/= floor'd)) (f/<= sample floor'd) (f/<= 1.0 (f/- floor'd sample))))) (test "The round will be an integer value, and will be < or > or = the original." - (let [round'd (&;round sample)] + (let [round'd (&.round sample)] (and (|> round'd frac-to-int int-to-frac (f/= round'd)) (f/<= 1.0 (frac/abs (f/- sample round'd)))))) )))) @@ -72,24 +72,24 @@ (context: "Exponentials and logarithms" (<| (times +100) (do @ - [sample (|> r;frac (:: @ map (f/* 10.0)))] + [sample (|> r.frac (:: @ map (f/* 10.0)))] (test "Logarithm is the inverse of exponential." - (|> sample &;exp &;log (within? 1.0e-15 sample)))))) + (|> sample &.exp &.log (within? 1.0e-15 sample)))))) (context: "Greatest-Common-Divisor and Least-Common-Multiple" (<| (times +100) (do @ - [#let [gen-nat (|> r;nat (:: @ map (|>> (n/% +1000) (n/max +1))))] + [#let [gen-nat (|> r.nat (:: @ map (|>> (n/% +1000) (n/max +1))))] x gen-nat y gen-nat] ($_ (test "GCD" - (let [gcd (&;gcd x y)] + (let [gcd (&.gcd x y)] (and (n/= +0 (n/% gcd x)) (n/= +0 (n/% gcd y)) (n/>= +1 gcd)))) (test "LCM" - (let [lcm (&;lcm x y)] + (let [lcm (&.lcm x y)] (and (n/= +0 (n/% x lcm)) (n/= +0 (n/% y lcm)) (n/<= (n/* x y) lcm)))) @@ -98,36 +98,36 @@ (context: "Infix syntax" (<| (times +100) (do @ - [x r;nat - y r;nat - z r;nat - theta r;frac + [x r.nat + y r.nat + z r.nat + theta r.frac #let [top (|> x (n/max y) (n/max z)) bottom (|> x (n/min y) (n/min z))]] ($_ seq (test "Constant values don't change." (n/= x - (&;infix x))) + (&.infix x))) (test "Can call binary functions." - (n/= (&;gcd y x) - (&;infix [x &;gcd y]))) + (n/= (&.gcd y x) + (&.infix [x &.gcd y]))) (test "Can call unary functions." - (f/= (&;sin theta) - (&;infix [&;sin theta]))) + (f/= (&.sin theta) + (&.infix [&.sin theta]))) (test "Can use regular syntax in the middle of infix code." - (n/= (&;gcd +450 (n/* +3 +9)) - (&;infix [(n/* +3 +9) &;gcd +450]))) + (n/= (&.gcd +450 (n/* +3 +9)) + (&.infix [(n/* +3 +9) &.gcd +450]))) (test "Can use non-numerical functions/macros as operators." (bool/= (and (n/< y x) (n/< z y)) - (&;infix [[x n/< y] and [y n/< z]]))) + (&.infix [[x n/< y] and [y n/< z]]))) (test "Can combine boolean operations in special ways via special keywords." (and (bool/= (and (n/< y x) (n/< z y)) - (&;infix [#and x n/< y n/< z])) + (&.infix [#and x n/< y n/< z])) (bool/= (and (n/< y x) (n/> z y)) - (&;infix [#and x n/< y n/> z])))) + (&.infix [#and x n/< y n/> z])))) )))) diff --git a/stdlib/test/test/lux/math/logic/continuous.lux b/stdlib/test/test/lux/math/logic/continuous.lux index 0bf2aabcf..68ddc376c 100644 --- a/stdlib/test/test/lux/math/logic/continuous.lux +++ b/stdlib/test/test/lux/math/logic/continuous.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -9,25 +9,25 @@ (context: "Operations" (<| (times +100) (do @ - [left r;deg - right r;deg] + [left r.deg + right r.deg] ($_ seq (test "AND is the minimum." - (let [result (&;~and left right)] + (let [result (&.~and left right)] (and (d/<= left result) (d/<= right result)))) (test "OR is the maximum." - (let [result (&;~or left right)] + (let [result (&.~or left right)] (and (d/>= left result) (d/>= right result)))) (test "Double negation results in the original value." - (d/= left (&;~not (&;~not left)))) + (d/= left (&.~not (&.~not left)))) (test "Every value is equivalent to itself." (and (d/>= left - (&;~= left left)) + (&.~= left left)) (d/>= right - (&;~= right right)))) + (&.~= right right)))) )))) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index 7be4d05f0..50423a973 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -16,15 +16,15 @@ [(context: (format "[" <desc> "] " "Triangles") (<| (times +100) (do @ - [values (r;set <hash> +3 <gen>) - #let [[x y z] (case (set;to-list values) + [values (r.set <hash> +3 <gen>) + #let [[x y z] (case (set.to-list values) (^ (list x y z)) [x y z] _ (undefined))] sample <gen> - #let [[bottom middle top] (case (list;sort <lt> (list x y z)) + #let [[bottom middle top] (case (list.sort <lt> (list x y z)) (^ (list bottom middle top)) [bottom middle top] @@ -33,40 +33,40 @@ triangle (<triangle> x y z)]] ($_ seq (test "The middle value will always have maximum membership." - (d/= ~true (&;membership middle triangle))) + (d/= ~true (&.membership middle triangle))) (test "Boundary values will always have 0 membership." - (and (d/= ~false (&;membership bottom triangle)) - (d/= ~false (&;membership top triangle)))) + (and (d/= ~false (&.membership bottom triangle)) + (d/= ~false (&.membership top triangle)))) (test "Values within range, will have membership > 0." - (B/= (d/> ~false (&;membership sample triangle)) + (B/= (d/> ~false (&.membership sample triangle)) (and (<gt> bottom sample) (<lt> top sample)))) (test "Values outside of range, will have membership = 0." - (B/= (d/= ~false (&;membership sample triangle)) + (B/= (d/= ~false (&.membership sample triangle)) (or (<lte> bottom sample) (<gte> top sample)))) ))))] - ["Frac" number;Hash<Frac> r;frac &;f/triangle f/< f/<= f/> f/>=] - ["Deg" number;Hash<Deg> r;deg &;d/triangle d/< d/<= d/> d/>=] + ["Frac" number.Hash<Frac> r.frac &.f/triangle f/< f/<= f/> f/>=] + ["Deg" number.Hash<Deg> r.deg &.d/triangle d/< d/<= d/> d/>=] ) (do-template [<desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>] [(context: (format "[" <desc> "] " "Trapezoids") (<| (times +100) (do @ - [values (r;set <hash> +4 <gen>) - #let [[w x y z] (case (set;to-list values) + [values (r.set <hash> +4 <gen>) + #let [[w x y z] (case (set.to-list values) (^ (list w x y z)) [w x y z] _ (undefined))] sample <gen> - #let [[bottom middle-bottom middle-top top] (case (list;sort <lt> (list w x y z)) + #let [[bottom middle-bottom middle-top top] (case (list.sort <lt> (list w x y z)) (^ (list bottom middle-bottom middle-top top)) [bottom middle-bottom middle-top top] @@ -75,115 +75,115 @@ trapezoid (<trapezoid> w x y z)]] ($_ seq (test "The middle values will always have maximum membership." - (and (d/= ~true (&;membership middle-bottom trapezoid)) - (d/= ~true (&;membership middle-top trapezoid)))) + (and (d/= ~true (&.membership middle-bottom trapezoid)) + (d/= ~true (&.membership middle-top trapezoid)))) (test "Boundary values will always have 0 membership." - (and (d/= ~false (&;membership bottom trapezoid)) - (d/= ~false (&;membership top trapezoid)))) + (and (d/= ~false (&.membership bottom trapezoid)) + (d/= ~false (&.membership top trapezoid)))) (test "Values within inner range will have membership = 1" - (B/= (d/= ~true (&;membership sample trapezoid)) + (B/= (d/= ~true (&.membership sample trapezoid)) (and (<gte> middle-bottom sample) (<lte> middle-top sample)))) (test "Values within range, will have membership > 0." - (B/= (d/> ~false (&;membership sample trapezoid)) + (B/= (d/> ~false (&.membership sample trapezoid)) (and (<gt> bottom sample) (<lt> top sample)))) (test "Values outside of range, will have membership = 0." - (B/= (d/= ~false (&;membership sample trapezoid)) + (B/= (d/= ~false (&.membership sample trapezoid)) (or (<lte> bottom sample) (<gte> top sample)))) ))))] - ["Frac" number;Hash<Frac> r;frac &;f/trapezoid f/< f/<= f/> f/>=] - ["Deg" number;Hash<Deg> r;deg &;d/trapezoid d/< d/<= d/> d/>=] + ["Frac" number.Hash<Frac> r.frac &.f/trapezoid f/< f/<= f/> f/>=] + ["Deg" number.Hash<Deg> r.deg &.d/trapezoid d/< d/<= d/> d/>=] ) (context: "Gaussian" (<| (times +100) (do @ - [deviation (|> r;frac (r;filter (f/> 0.0))) - center r;frac - #let [gaussian (&;gaussian deviation center)]] + [deviation (|> r.frac (r.filter (f/> 0.0))) + center r.frac + #let [gaussian (&.gaussian deviation center)]] (test "The center value will always have maximum membership." - (d/= ~true (&;membership center gaussian)))))) + (d/= ~true (&.membership center gaussian)))))) (def: gen-triangle - (r;Random (&;Fuzzy Frac)) - (do r;Monad<Random> - [x r;frac - y r;frac - z r;frac] - (wrap (&;f/triangle x y z)))) + (r.Random (&.Fuzzy Frac)) + (do r.Monad<Random> + [x r.frac + y r.frac + z r.frac] + (wrap (&.f/triangle x y z)))) (context: "Combinators" (<| (times +100) (do @ [left gen-triangle right gen-triangle - sample r;frac] + sample r.frac] ($_ seq (test "Union membership as as high as membership in any of its members." - (let [combined (&;union left right) - combined-membership (&;membership sample combined)] - (and (d/>= (&;membership sample left) + (let [combined (&.union left right) + combined-membership (&.membership sample combined)] + (and (d/>= (&.membership sample left) combined-membership) - (d/>= (&;membership sample right) + (d/>= (&.membership sample right) combined-membership)))) (test "Intersection membership as as low as membership in any of its members." - (let [combined (&;intersection left right) - combined-membership (&;membership sample combined)] - (and (d/<= (&;membership sample left) + (let [combined (&.intersection left right) + combined-membership (&.membership sample combined)] + (and (d/<= (&.membership sample left) combined-membership) - (d/<= (&;membership sample right) + (d/<= (&.membership sample right) combined-membership)))) (test "Complement membership is the opposite of normal membership." - (d/= (&;membership sample left) - (~not (&;membership sample (&;complement left))))) + (d/= (&.membership sample left) + (~not (&.membership sample (&.complement left))))) (test "Membership in the difference will never be higher than in the set being subtracted." - (B/= (d/> (&;membership sample right) - (&;membership sample left)) - (d/< (&;membership sample left) - (&;membership sample (&;difference left right))))) + (B/= (d/> (&.membership sample right) + (&.membership sample left)) + (d/< (&.membership sample left) + (&.membership sample (&.difference left right))))) )))) (context: "From predicates and sets" (<| (times +100) (do @ - [#let [set-10 (set;from-list number;Hash<Nat> (list;n/range +0 +10))] - sample (|> r;nat (:: @ map (n/% +20)))] + [#let [set-10 (set.from-list number.Hash<Nat> (list.n/range +0 +10))] + sample (|> r.nat (:: @ map (n/% +20)))] ($_ seq (test "Values that satisfy a predicate have membership = 1. Values that don't have membership = 0." - (B/= (d/= ~true (&;membership sample (&;from-predicate n/even?))) + (B/= (d/= ~true (&.membership sample (&.from-predicate n/even?))) (n/even? sample))) (test "Values that belong to a set have membership = 1. Values that don't have membership = 0." - (B/= (d/= ~true (&;membership sample (&;from-set set-10))) - (set;member? set-10 sample))) + (B/= (d/= ~true (&.membership sample (&.from-set set-10))) + (set.member? set-10 sample))) )))) (context: "Thresholds" (<| (times +100) (do @ [fuzzy gen-triangle - sample r;frac - threshold r;deg - #let [vip-fuzzy (&;cut threshold fuzzy) - member? (&;to-predicate threshold fuzzy)]] + sample r.frac + threshold r.deg + #let [vip-fuzzy (&.cut threshold fuzzy) + member? (&.to-predicate threshold fuzzy)]] ($_ seq (test "Can increase the threshold of membership of a fuzzy set." - (B/= (d/> ~false (&;membership sample vip-fuzzy)) - (d/> threshold (&;membership sample fuzzy)))) + (B/= (d/> ~false (&.membership sample vip-fuzzy)) + (d/> threshold (&.membership sample fuzzy)))) (test "Can turn fuzzy sets into predicates through a threshold." (B/= (member? sample) - (d/> threshold (&;membership sample fuzzy)))) + (d/> threshold (&.membership sample fuzzy)))) )))) diff --git a/stdlib/test/test/lux/math/random.lux b/stdlib/test/test/lux/math/random.lux index 5fc91db75..b5e305ff7 100644 --- a/stdlib/test/test/lux/math/random.lux +++ b/stdlib/test/test/lux/math/random.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -17,40 +17,40 @@ (context: "Random." (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) - _list (r;list size r;nat) - _sequence (r;sequence size r;nat) - _array (r;array size r;nat) - _queue (r;queue size r;nat) - _stack (r;stack size r;nat) - _set (r;set number;Hash<Nat> size r;nat) - _dict (r;dict number;Hash<Nat> size r;nat r;nat) - top r;nat - filtered (|> r;nat (r;filter (n/<= top))) - shuffle-seed r;nat - #let [sorted (|> _sequence sequence;to-list (list;sort n/<)) - shuffled (|> sorted sequence;from-list (r;shuffle shuffle-seed)) - re-sorted (|> shuffled sequence;to-list (list;sort n/<))]] + [size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) + _list (r.list size r.nat) + _sequence (r.sequence size r.nat) + _array (r.array size r.nat) + _queue (r.queue size r.nat) + _stack (r.stack size r.nat) + _set (r.set number.Hash<Nat> size r.nat) + _dict (r.dict number.Hash<Nat> size r.nat r.nat) + top r.nat + filtered (|> r.nat (r.filter (n/<= top))) + shuffle-seed r.nat + #let [sorted (|> _sequence sequence.to-list (list.sort n/<)) + shuffled (|> sorted sequence.from-list (r.shuffle shuffle-seed)) + re-sorted (|> shuffled sequence.to-list (list.sort n/<))]] ($_ seq (test "Can produce lists." - (n/= size (list;size _list))) + (n/= size (list.size _list))) (test "Can produce sequences." - (n/= size (sequence;size _sequence))) + (n/= size (sequence.size _sequence))) (test "Can produce arrays." - (n/= size (array;size _array))) + (n/= size (array.size _array))) (test "Can produce queues." - (n/= size (queue;size _queue))) + (n/= size (queue.size _queue))) (test "Can produce stacks." - (n/= size (stack;size _stack))) + (n/= size (stack.size _stack))) (test "Can produce sets." - (n/= size (set;size _set))) + (n/= size (set.size _set))) (test "Can produce dicts." - (n/= size (dict;size _dict))) + (n/= size (dict.size _dict))) (test "Can filter values." (n/<= top filtered)) (test "Can shuffle sequences." - (let [(^open "v/") (sequence;Eq<Sequence> number;Eq<Nat>) - sorted (sequence;from-list sorted)] + (let [(^open "v/") (sequence.Eq<Sequence> number.Eq<Nat>) + sorted (sequence.from-list sorted)] (and (not (v/= sorted shuffled)) - (v/= sorted (sequence;from-list re-sorted))))) + (v/= sorted (sequence.from-list re-sorted))))) )))) diff --git a/stdlib/test/test/lux/time/date.lux b/stdlib/test/test/lux/time/date.lux index 634984bbc..7d7ca03fe 100644 --- a/stdlib/test/test/lux/time/date.lux +++ b/stdlib/test/test/lux/time/date.lux @@ -1,35 +1,35 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] [pipe]) (data ["E" error]) (math ["r" random "r/" Monad<Random>]) - (time ["@;" instant] + (time ["@." instant] ["@" date])) lux/test - (test (lux (time ["_;" instant])))) + (test (lux (time ["_." instant])))) (def: month - (r;Random @;Month) - (r;either (r;either (r;either (r/wrap #@;January) - (r;either (r/wrap #@;February) - (r/wrap #@;March))) - (r;either (r/wrap #@;April) - (r;either (r/wrap #@;May) - (r/wrap #@;June)))) - (r;either (r;either (r/wrap #@;July) - (r;either (r/wrap #@;August) - (r/wrap #@;September))) - (r;either (r/wrap #@;October) - (r;either (r/wrap #@;November) - (r/wrap #@;December)))))) + (r.Random @.Month) + (r.either (r.either (r.either (r/wrap #@.January) + (r.either (r/wrap #@.February) + (r/wrap #@.March))) + (r.either (r/wrap #@.April) + (r.either (r/wrap #@.May) + (r/wrap #@.June)))) + (r.either (r.either (r/wrap #@.July) + (r.either (r/wrap #@.August) + (r/wrap #@.September))) + (r.either (r/wrap #@.October) + (r.either (r/wrap #@.November) + (r/wrap #@.December)))))) (context: "(Month) Eq." (<| (times +100) (do @ [sample month - #let [(^open "@/") @;Eq<Month>]] + #let [(^open "@/") @.Eq<Month>]] (test "Every value equals itself." (@/= sample sample))))) @@ -38,7 +38,7 @@ (do @ [reference month sample month - #let [(^open "@/") @;Order<Month>]] + #let [(^open "@/") @.Order<Month>]] (test "Valid Order." (and (or (@/< reference sample) (@/>= reference sample)) @@ -49,7 +49,7 @@ (<| (times +100) (do @ [sample month - #let [(^open "@/") @;Enum<Month>]] + #let [(^open "@/") @.Enum<Month>]] (test "Valid Enum." (and (not (@/= (@/succ sample) sample)) @@ -59,20 +59,20 @@ (|> sample @/pred @/succ (@/= sample))))))) (def: day - (r;Random @;Day) - (r;either (r;either (r;either (r/wrap #@;Sunday) - (r/wrap #@;Monday)) - (r;either (r/wrap #@;Tuesday) - (r/wrap #@;Wednesday))) - (r;either (r;either (r/wrap #@;Thursday) - (r/wrap #@;Friday)) - (r/wrap #@;Saturday)))) + (r.Random @.Day) + (r.either (r.either (r.either (r/wrap #@.Sunday) + (r/wrap #@.Monday)) + (r.either (r/wrap #@.Tuesday) + (r/wrap #@.Wednesday))) + (r.either (r.either (r/wrap #@.Thursday) + (r/wrap #@.Friday)) + (r/wrap #@.Saturday)))) (context: "(Day) Eq." (<| (times +100) (do @ [sample day - #let [(^open "@/") @;Eq<Day>]] + #let [(^open "@/") @.Eq<Day>]] (test "Every value equals itself." (@/= sample sample))))) @@ -81,7 +81,7 @@ (do @ [reference day sample day - #let [(^open "@/") @;Order<Day>]] + #let [(^open "@/") @.Order<Day>]] (test "Valid Order." (and (or (@/< reference sample) (@/>= reference sample)) @@ -92,7 +92,7 @@ (<| (times +100) (do @ [sample day - #let [(^open "@/") @;Enum<Day>]] + #let [(^open "@/") @.Enum<Day>]] (test "Valid Enum." (and (not (@/= (@/succ sample) sample)) @@ -102,14 +102,14 @@ (|> sample @/pred @/succ (@/= sample))))))) (def: #export date - (r;Random @;Date) - (|> _instant;instant (:: r;Monad<Random> map @instant;date))) + (r.Random @.Date) + (|> _instant.instant (:: r.Monad<Random> map @instant.date))) (context: "(Date) Eq." (<| (times +100) (do @ [sample date - #let [(^open "@/") @;Eq<Date>]] + #let [(^open "@/") @.Eq<Date>]] (test "Every value equals itself." (@/= sample sample))))) @@ -118,7 +118,7 @@ (do @ [reference date sample date - #let [(^open "@/") @;Order<Date>]] + #let [(^open "@/") @.Order<Date>]] (test "Valid Order." (and (or (@/< reference sample) (@/>= reference sample)) @@ -129,14 +129,14 @@ (<| (seed +1501531301120) (do @ [sample date - #let [(^open "@/") @;Eq<Date> - (^open "@/") @;Codec<Text,Date>]] + #let [(^open "@/") @.Eq<Date> + (^open "@/") @.Codec<Text,Date>]] (test "Can encode/decode dates." (|> sample @/encode @/decode - (pipe;case> (#E;Success decoded) + (pipe.case> (#E.Success decoded) (@/= sample decoded) - (#E;Error error) + (#E.Error error) false)))))) diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux index e84ef6471..3529852a0 100644 --- a/stdlib/test/test/lux/time/duration.lux +++ b/stdlib/test/test/lux/time/duration.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad]) @@ -8,21 +8,21 @@ lux/test) (def: #export duration - (r;Random @;Duration) - (|> r;int (:: r;Monad<Random> map @;from-millis))) + (r.Random @.Duration) + (|> r.int (:: r.Monad<Random> map @.from-millis))) (context: "Conversion." (<| (times +100) (do @ - [millis r;int] + [millis r.int] (test "Can convert from/to milliseconds." - (|> millis @;from-millis @;to-millis (i/= millis)))))) + (|> millis @.from-millis @.to-millis (i/= millis)))))) (context: "Equality" (<| (times +100) (do @ [sample duration - #let [(^open "@/") @;Eq<Duration>]] + #let [(^open "@/") @.Eq<Duration>]] (test "Every duration equals itself." (@/= sample sample))))) @@ -31,7 +31,7 @@ (do @ [reference duration sample duration - #let [(^open "@/") @;Order<Duration>]] + #let [(^open "@/") @.Order<Duration>]] (test "Can compare times." (and (or (@/< reference sample) (@/>= reference sample)) @@ -41,42 +41,42 @@ (context: "Arithmetic." (<| (times +100) (do @ - [sample (|> duration (:: @ map (@;frame @;day))) + [sample (|> duration (:: @ map (@.frame @.day))) frame duration - factor (|> r;int (:: @ map (|>> (i/% 10) (i/max 1)))) - #let [(^open "@/") @;Order<Duration>]] + factor (|> r.int (:: @ map (|>> (i/% 10) (i/max 1)))) + #let [(^open "@/") @.Order<Duration>]] ($_ seq (test "Can scale a duration." - (|> sample (@;scale factor) (@;query sample) (i/= factor))) + (|> sample (@.scale factor) (@.query sample) (i/= factor))) (test "Scaling a duration by one does not change it." - (|> sample (@;scale 1) (@/= sample))) + (|> sample (@.scale 1) (@/= sample))) (test "Merging with the empty duration changes nothing." - (|> sample (@;merge @;empty) (@/= sample))) + (|> sample (@.merge @.empty) (@/= sample))) (test "Merging a duration with it's opposite yields an empty duration." - (|> sample (@;merge (@;scale -1 sample)) (@/= @;empty))) + (|> sample (@.merge (@.scale -1 sample)) (@/= @.empty))) (test "Can frame a duration in terms of another." - (cond (and (@;positive? frame) (@;positive? sample)) - (|> sample (@;frame frame) (@/< frame)) + (cond (and (@.positive? frame) (@.positive? sample)) + (|> sample (@.frame frame) (@/< frame)) - (and (@;negative? frame) (@;negative? sample)) - (|> sample (@;frame frame) (@/> frame)) + (and (@.negative? frame) (@.negative? sample)) + (|> sample (@.frame frame) (@/> frame)) - (or (or (@;neutral? frame) (@;neutral? sample)) + (or (or (@.neutral? frame) (@.neutral? sample)) (|> sample - (@;frame frame) - (@;scale -1) - (@/< (if (@;negative? frame) - (@;scale -1 frame) + (@.frame frame) + (@.scale -1) + (@/< (if (@.negative? frame) + (@.scale -1 frame) frame)))))))))) (context: "Codec" (<| (times +100) (do @ [sample duration - #let [(^open "@/") @;Eq<Duration> - (^open "@/") @;Codec<Text,Duration>]] + #let [(^open "@/") @.Eq<Duration> + (^open "@/") @.Codec<Text,Duration>]] (test "Can encode/decode durations." - (E;default false - (do E;Monad<Error> + (E.default false + (do E.Monad<Error> [decoded (|> sample @/encode @/decode)] (wrap (@/= sample decoded)))))))) diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux index d56ef1062..a264e6155 100644 --- a/stdlib/test/test/lux/time/instant.lux +++ b/stdlib/test/test/lux/time/instant.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -12,26 +12,26 @@ ["@d" duration] ["@date" date])) lux/test - (// ["_;" duration])) + (// ["_." duration])) (def: boundary Int 99_999_999_999_999) (def: #export instant - (r;Random @;Instant) - (|> r;int (:: r;Monad<Random> map (|>> (i/% boundary) @;from-millis)))) + (r.Random @.Instant) + (|> r.int (:: r.Monad<Random> map (|>> (i/% boundary) @.from-millis)))) (context: "Conversion." (<| (times +100) (do @ - [millis r;int] + [millis r.int] (test "Can convert from/to milliseconds." - (|> millis @;from-millis @;to-millis (i/= millis)))))) + (|> millis @.from-millis @.to-millis (i/= millis)))))) (context: "Equality" (<| (times +100) (do @ [sample instant - #let [(^open "@/") @;Eq<Instant>]] + #let [(^open "@/") @.Eq<Instant>]] (test "Every instant equals itself." (@/= sample sample))))) @@ -40,7 +40,7 @@ (do @ [reference instant sample instant - #let [(^open "@/") @;Order<Instant>]] + #let [(^open "@/") @.Order<Instant>]] (test "Can compare instants." (and (or (@/< reference sample) (@/>= reference sample)) @@ -51,7 +51,7 @@ (<| (times +100) (do @ [sample instant - #let [(^open "@/") @;Enum<Instant>]] + #let [(^open "@/") @.Enum<Instant>]] (test "Valid Enum." (and (not (@/= (@/succ sample) sample)) @@ -64,32 +64,32 @@ (<| (times +100) (do @ [sample instant - span _duration;duration - #let [(^open "@/") @;Eq<Instant> - (^open "@d/") @d;Eq<Duration>]] + span _duration.duration + #let [(^open "@/") @.Eq<Instant> + (^open "@d/") @d.Eq<Duration>]] ($_ seq (test "The span of a instant and itself has an empty duration." - (|> sample (@;span sample) (@d/= @d;empty))) + (|> sample (@.span sample) (@d/= @d.empty))) (test "Can shift a instant by a duration." - (|> sample (@;shift span) (@;span sample) (@d/= span))) + (|> sample (@.shift span) (@.span sample) (@d/= span))) (test "Can obtain the time-span between the epoch and an instant." - (|> sample @;relative @;absolute (@/= sample))) + (|> sample @.relative @.absolute (@/= sample))) (test "All instants are relative to the epoch." - (|> @;epoch (@;shift (@;relative sample)) (@/= sample))))))) + (|> @.epoch (@.shift (@.relative sample)) (@/= sample))))))) (context: "Codec" (<| (seed +9863552679229274604) ## (times +100) (do @ [sample instant - #let [(^open "@/") @;Eq<Instant> - (^open "@/") @;Codec<Text,Instant>]] + #let [(^open "@/") @.Eq<Instant> + (^open "@/") @.Codec<Text,Instant>]] (test "Can encode/decode instants." (|> sample @/encode @/decode - (case> (#E;Success decoded) + (case> (#E.Success decoded) (@/= sample decoded) - (#E;Error error) + (#E.Error error) false)))))) diff --git a/stdlib/test/test/lux/type/implicit.lux b/stdlib/test/test/lux/type/implicit.lux index 662c2df80..a4dee260e 100644 --- a/stdlib/test/test/lux/type/implicit.lux +++ b/stdlib/test/test/lux/type/implicit.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do Monad] @@ -15,24 +15,24 @@ (context: "Automatic structure selection" (<| (times +100) (do @ - [x r;nat - y r;nat] + [x r.nat + y r.nat] ($_ seq (test "Can automatically select first-order structures." - (let [(^open "list/") (list;Eq<List> number;Eq<Nat>)] - (and (bool/= (:: number;Eq<Nat> = x y) + (let [(^open "list/") (list.Eq<List> number.Eq<Nat>)] + (and (bool/= (:: number.Eq<Nat> = x y) (::: = x y)) - (list/= (list;n/range +1 +10) - (::: map n/inc (list;n/range +0 +9))) + (list/= (list.n/range +1 +10) + (::: map n/inc (list.n/range +0 +9))) ))) (test "Can automatically select second-order structures." (::: = - (list;n/range +1 +10) - (list;n/range +1 +10))) + (list.n/range +1 +10) + (list.n/range +1 +10))) (test "Can automatically select third-order structures." - (let [lln (::: map (list;n/range +1) - (list;n/range +1 +10))] + (let [lln (::: map (list.n/range +1) + (list.n/range +1 +10))] (::: = lln lln))) )))) diff --git a/stdlib/test/test/lux/type/object.lux b/stdlib/test/test/lux/type/object.lux index 4884f342a..7ca601792 100644 --- a/stdlib/test/test/lux/type/object.lux +++ b/stdlib/test/test/lux/type/object.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data (coll [list])) (type object))) @@ -37,10 +37,10 @@ (List a) (def: (add elem) - (update@Collection (|>> (#;Cons elem)))) + (update@Collection (|>> (#.Cons elem)))) (def: size - (|>> get@Collection list;size))) + (|>> get@Collection list.size))) (interface: (Iterable a) #super (Collection a) diff --git a/stdlib/test/test/lux/world/blob.lux b/stdlib/test/test/lux/world/blob.lux index c478818c0..bd185d16f 100644 --- a/stdlib/test/test/lux/world/blob.lux +++ b/stdlib/test/test/lux/world/blob.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -11,99 +11,99 @@ lux/test) (def: (succeed result) - (-> (e;Error Bool) Bool) + (-> (e.Error Bool) Bool) (case result - (#e;Error _) + (#e.Error _) false - (#e;Success output) + (#e.Success output) output)) (def: #export (blob size) - (-> Nat (r;Random @;Blob)) - (let [blob (@;create size)] - (do r;Monad<Random> + (-> Nat (r.Random @.Blob)) + (let [blob (@.create size)] + (do r.Monad<Random> [] (loop [idx +0] (if (n/< size idx) (do @ - [byte r;nat] - (exec (e;assume (@;write-8 idx byte blob)) + [byte r.nat] + (exec (e.assume (@.write-8 idx byte blob)) (recur (n/inc idx)))) (wrap blob)))))) (context: "Blob." (<| (times +100) (do @ - [blob-size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +8)))) + [blob-size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +8)))) random-blob (blob blob-size) - #let [clean-blob (@;create blob-size) - size (@;size clean-blob)] - value r;nat - idx (|> r;nat (:: @ map (n/% size))) - [from to] (|> (r;list +2 (|> r;nat (:: @ map (n/% size)))) + #let [clean-blob (@.create blob-size) + size (@.size clean-blob)] + value r.nat + idx (|> r.nat (:: @ map (n/% size))) + [from to] (|> (r.list +2 (|> r.nat (:: @ map (n/% size)))) (:: @ map - (|>> (list;sort n/<) - (pipe;case> (^ (list from to)) + (|>> (list.sort n/<) + (pipe.case> (^ (list from to)) [from to] _ (undefined))))) - #let [value-8 (n/% (bit;shift-left +8 +1) value) - value-16 (n/% (bit;shift-left +16 +1) value) - value-32 (n/% (bit;shift-left +32 +1) value) + #let [value-8 (n/% (bit.shift-left +8 +1) value) + value-16 (n/% (bit.shift-left +16 +1) value) + value-32 (n/% (bit.shift-left +32 +1) value) value-64 value slice-size (|> to (n/- from) n/inc) - random-slice (e;assume (@;slice from to random-blob))]] + random-slice (e.assume (@.slice from to random-blob))]] ($_ seq (test "Has equality." - (and (:: @;Eq<Blob> = clean-blob clean-blob) - (:: @;Eq<Blob> = - (e;assume (@;slice from to clean-blob)) - (e;assume (@;slice from to clean-blob))))) + (and (:: @.Eq<Blob> = clean-blob clean-blob) + (:: @.Eq<Blob> = + (e.assume (@.slice from to clean-blob)) + (e.assume (@.slice from to clean-blob))))) (test "Can get size of blob." (n/= blob-size size)) (test "Can read/write 8-bit values." (succeed - (do e;Monad<Error> - [_ (@;write-8 idx value-8 clean-blob) - output-8 (@;read-8 idx clean-blob)] + (do e.Monad<Error> + [_ (@.write-8 idx value-8 clean-blob) + output-8 (@.read-8 idx clean-blob)] (wrap (n/= value-8 output-8))))) (test "Can read/write 16-bit values." (or (n/>= size (n/+ +1 idx)) (succeed - (do e;Monad<Error> - [_ (@;write-16 idx value-16 clean-blob) - output-16 (@;read-16 idx clean-blob)] + (do e.Monad<Error> + [_ (@.write-16 idx value-16 clean-blob) + output-16 (@.read-16 idx clean-blob)] (wrap (n/= value-16 output-16)))))) (test "Can read/write 32-bit values." (or (n/>= size (n/+ +3 idx)) (succeed - (do e;Monad<Error> - [_ (@;write-32 idx value-32 clean-blob) - output-32 (@;read-32 idx clean-blob)] + (do e.Monad<Error> + [_ (@.write-32 idx value-32 clean-blob) + output-32 (@.read-32 idx clean-blob)] (wrap (n/= value-32 output-32)))))) (test "Can read/write 64-bit values." (or (n/>= size (n/+ +7 idx)) (succeed - (do e;Monad<Error> - [_ (@;write-64 idx value-64 clean-blob) - output-64 (@;read-64 idx clean-blob)] + (do e.Monad<Error> + [_ (@.write-64 idx value-64 clean-blob) + output-64 (@.read-64 idx clean-blob)] (wrap (n/= value-64 output-64)))))) (test "Can slice blobs." - (and (n/= slice-size (@;size random-slice)) + (and (n/= slice-size (@.size random-slice)) (loop [idx +0] (let [loop-recur recur] (if (n/< slice-size idx) (and (succeed - (do e;Monad<Error> - [reference (@;read-8 (n/+ from idx) random-blob) - sample (@;read-8 idx random-slice)] + (do e.Monad<Error> + [reference (@.read-8 (n/+ from idx) random-blob) + sample (@.read-8 idx random-slice)] (wrap (n/= reference sample)))) (loop-recur (n/inc idx))) true))))) (test "Slicing the whole blob does not change anything." - (:: @;Eq<Blob> = + (:: @.Eq<Blob> = random-blob - (e;assume (@;slice +0 (n/dec blob-size) random-blob)))) + (e.assume (@.slice +0 (n/dec blob-size) random-blob)))) )))) diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux index b33978531..1721c8cbb 100644 --- a/stdlib/test/test/lux/world/file.lux +++ b/stdlib/test/test/lux/world/file.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do]) @@ -14,149 +14,149 @@ [blob]) ["r" math/random]) lux/test - (// ["_;" blob])) + (// ["_." blob])) (def: truncate-millis (|>> (i// 1_000) (i/* 1_000))) (context: "File system." (do @ - [file-size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) - dataL (_blob;blob file-size) - dataR (_blob;blob file-size) - code r;nat - last-modified (|> r;int (:: @ map (|>> (:: number;Number<Int> abs) + [file-size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) + dataL (_blob.blob file-size) + dataR (_blob.blob file-size) + code r.nat + last-modified (|> r.int (:: @ map (|>> (:: number.Number<Int> abs) truncate-millis - d;from-millis - i;absolute)))] + d.from-millis + i.absolute)))] ($_ seq - (wrap (do P;Monad<Promise> + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +0 code)))] - result (do T;Monad<Task> - [pre (@;exists? file) - _ (@;write dataL file) - post (@;exists? file) - deleted? (@;delete file) - remains? (@;exists? file)] + result (do T.Monad<Task> + [pre (@.exists? file) + _ (@.write dataL file) + post (@.exists? file) + deleted? (@.delete file) + remains? (@.exists? file)] (wrap (and (not pre) post deleted? (not remains?))))] (assert "Can create/delete files." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +1 code)))] - result (do T;Monad<Task> - [_ (@;write dataL file) - output (@;read file) - _ (@;delete file)] - (wrap (:: blob;Eq<Blob> = dataL output)))] + result (do T.Monad<Task> + [_ (@.write dataL file) + output (@.read file) + _ (@.delete file)] + (wrap (:: blob.Eq<Blob> = dataL output)))] (assert "Can write/read files." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +2 code)))] - result (do T;Monad<Task> - [_ (@;write dataL file) - read-size (@;size file) - _ (@;delete file)] + result (do T.Monad<Task> + [_ (@.write dataL file) + read-size (@.size file) + _ (@.delete file)] (wrap (n/= file-size read-size)))] (assert "Can read file size." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +3 code)))] - result (do T;Monad<Task> - [_ (@;write dataL file) - _ (@;append dataR file) - output (@;read file) - read-size (@;size file) - _ (@;delete file)] + result (do T.Monad<Task> + [_ (@.write dataL file) + _ (@.append dataR file) + output (@.read file) + read-size (@.size file) + _ (@.delete file)] (wrap (and (n/= (n/* +2 file-size) read-size) - (:: blob;Eq<Blob> = dataL (E;assume (blob;slice +0 (n/dec file-size) output))) - (:: blob;Eq<Blob> = dataR (E;assume (blob;slice file-size (n/dec read-size) output))))))] + (:: blob.Eq<Blob> = dataL (E.assume (blob.slice +0 (n/dec file-size) output))) + (:: blob.Eq<Blob> = dataR (E.assume (blob.slice file-size (n/dec read-size) output))))))] (assert "Can append to files." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [dir (format "temp_dir_" (%n (n/+ +4 code)))] - result (do T;Monad<Task> - [pre (@;exists? dir) - _ (@;make-dir dir) - post (@;exists? dir) - deleted? (@;delete dir) - remains? (@;exists? dir)] + result (do T.Monad<Task> + [pre (@.exists? dir) + _ (@.make-dir dir) + post (@.exists? dir) + deleted? (@.delete dir) + remains? (@.exists? dir)] (wrap (and (not pre) post deleted? (not remains?))))] (assert "Can create/delete directories." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +5 code))) dir (format "temp_dir_" (%n (n/+ +5 code)))] - result (do T;Monad<Task> - [_ (@;write dataL file) - file-is-file (@;file? file) - file-is-directory (@;directory? file) - _ (@;delete file) - _ (@;make-dir dir) - directory-is-file (@;file? dir) - directory-is-directory (@;directory? dir) - _ (@;delete dir)] + result (do T.Monad<Task> + [_ (@.write dataL file) + file-is-file (@.file? file) + file-is-directory (@.directory? file) + _ (@.delete file) + _ (@.make-dir dir) + directory-is-file (@.file? dir) + directory-is-directory (@.directory? dir) + _ (@.delete dir)] (wrap (and file-is-file (not file-is-directory) (not directory-is-file) directory-is-directory)))] (assert "Can differentiate files from directories." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +6 code))) dir (format "temp_dir_" (%n (n/+ +6 code)))] - result (do T;Monad<Task> - [_ (@;make-dir dir) + result (do T.Monad<Task> + [_ (@.make-dir dir) #let [file' (format dir "/" file)] - _ (@;write dataL file') - read-size (@;size file') - deleted-file (@;delete file') - deleted-dir (@;delete dir)] + _ (@.write dataL file') + read-size (@.size file') + deleted-file (@.delete file') + deleted-dir (@.delete dir)] (wrap (and (n/= file-size read-size) deleted-file deleted-dir)))] (assert "Can create files inside of directories." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +7 code))) dir (format "temp_dir_" (%n (n/+ +7 code)))] - result (do T;Monad<Task> - [_ (@;make-dir dir) + result (do T.Monad<Task> + [_ (@.make-dir dir) #let [file' (format dir "/" file)] - _ (@;write dataL file') - children (@;files dir) - _ (@;delete file') - _ (@;delete dir)] + _ (@.write dataL file') + children (@.files dir) + _ (@.delete file') + _ (@.delete dir)] (wrap (case children (^ (list child)) - (text;ends-with? file' child) + (text.ends-with? file' child) _ false)))] (assert "Can list files inside a directory." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +8 code)))] - result (do T;Monad<Task> - [_ (@;write dataL file) - was-modified? (@;set-last-modified last-modified file) - time-read (@;get-last-modified file) - _ (@;delete file)] + result (do T.Monad<Task> + [_ (@.write dataL file) + was-modified? (@.set-last-modified last-modified file) + time-read (@.get-last-modified file) + _ (@.delete file)] (wrap (and was-modified? - (:: i;Eq<Instant> = last-modified time-read))))] + (:: i.Eq<Instant> = last-modified time-read))))] (assert "Can change the time of last modification." - (E;default false result)))) - (wrap (do P;Monad<Promise> + (E.default false result)))) + (wrap (do P.Monad<Promise> [#let [file0 (format "temp_file_" (%n (n/+ +9 code)) "0") file1 (format "temp_file_" (%n (n/+ +9 code)) "1")] - result (do T;Monad<Task> - [_ (@;write dataL file0) - pre (@;exists? file0) - moved? (@;move file1 file0) - post (@;exists? file0) - confirmed? (@;exists? file1) - deleted? (@;delete file1)] + result (do T.Monad<Task> + [_ (@.write dataL file0) + pre (@.exists? file0) + moved? (@.move file1 file0) + post (@.exists? file0) + confirmed? (@.exists? file1) + deleted? (@.delete file1)] (wrap (and pre moved? (not post) confirmed? deleted?)))] (assert "Can move a file from one path to another." - (E;default false result)))) + (E.default false result)))) ))) diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux index a57ab0544..785b1a66b 100644 --- a/stdlib/test/test/lux/world/net/tcp.lux +++ b/stdlib/test/test/lux/world/net/tcp.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -14,57 +14,57 @@ (net ["@" tcp])) ["r" math/random]) lux/test - (/// ["_;" blob])) + (/// ["_." blob])) -(def: localhost net;Address "127.0.0.1") +(def: localhost net.Address "127.0.0.1") (def: port - (r;Random net;Port) - (|> r;nat - (:: r;Monad<Random> map + (r.Random net.Port) + (|> r.nat + (:: r.Monad<Random> map (|>> (n/% +1000) (n/+ +8000))))) (exception: Empty-Channel) (def: (head channel) - (All [a] (-> (frp;Channel a) (T;Task a))) - (do P;Monad<Promise> + (All [a] (-> (frp.Channel a) (T.Task a))) + (do P.Monad<Promise> [head+tail channel] (case head+tail - (#;Some [head tail]) - (wrap (ex;return head)) + (#.Some [head tail]) + (wrap (ex.return head)) - #;None - (wrap (ex;throw Empty-Channel ""))))) + #.None + (wrap (ex.throw Empty-Channel ""))))) (context: "TCP networking." (do @ - [port ;;port - size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) - from (_blob;blob size) - to (_blob;blob size) - #let [temp (blob;create size)]] + [port ..port + size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) + from (_blob.blob size) + to (_blob.blob size) + #let [temp (blob.create size)]] ($_ seq - (wrap (do P;Monad<Promise> - [result (do T;Monad<Task> - [server (@;server port) - client (@;client localhost port) + (wrap (do P.Monad<Promise> + [result (do T.Monad<Task> + [server (@.server port) + client (@.client localhost port) #################### - _ (@;write from +0 size client) + _ (@.write from +0 size client) socket (head server) - bytes-from (@;read temp +0 size socket) + bytes-from (@.read temp +0 size socket) #let [from-worked? (and (n/= size bytes-from) - (:: blob;Eq<Blob> = from temp))] + (:: blob.Eq<Blob> = from temp))] #################### - _ (@;write to +0 size socket) - bytes-to (@;read temp +0 size client) + _ (@.write to +0 size socket) + bytes-to (@.read temp +0 size client) #let [to-worked? (and (n/= size bytes-to) - (:: blob;Eq<Blob> = to temp))] + (:: blob.Eq<Blob> = to temp))] #################### - _ (@;close client) - _ (T;from-promise (P;future (frp;close server)))] + _ (@.close client) + _ (T.from-promise (P.future (frp.close server)))] (wrap (and from-worked? to-worked?)))] (assert "Can communicate between client and server." - (E;default false result)))) + (E.default false result)))) ))) diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux index cc3ad6fc7..aa600e0b5 100644 --- a/stdlib/test/test/lux/world/net/udp.lux +++ b/stdlib/test/test/lux/world/net/udp.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io] (control [monad #+ do] @@ -14,57 +14,57 @@ (net ["@" udp])) ["r" math/random]) lux/test - (/// ["_;" blob])) + (/// ["_." blob])) -(def: localhost net;Address "127.0.0.1") +(def: localhost net.Address "127.0.0.1") (def: port - (r;Random net;Port) - (|> r;nat - (:: r;Monad<Random> map + (r.Random net.Port) + (|> r.nat + (:: r.Monad<Random> map (|>> (n/% +1000) (n/+ +8000))))) (exception: Empty-Channel) (def: (head channel) - (All [a] (-> (frp;Channel a) (T;Task a))) - (do P;Monad<Promise> + (All [a] (-> (frp.Channel a) (T.Task a))) + (do P.Monad<Promise> [head+tail channel] (case head+tail - (#;Some [head tail]) - (wrap (ex;return head)) + (#.Some [head tail]) + (wrap (ex.return head)) - #;None - (wrap (ex;throw Empty-Channel ""))))) + #.None + (wrap (ex.throw Empty-Channel ""))))) (context: "UDP networking." (do @ - [port ;;port - size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) - from (_blob;blob size) - to (_blob;blob size) - #let [temp (blob;create size)]] + [port ..port + size (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10)))) + from (_blob.blob size) + to (_blob.blob size) + #let [temp (blob.create size)]] ($_ seq - (wrap (do P;Monad<Promise> - [result (do T;Monad<Task> - [server (@;server port) - client (@;client []) + (wrap (do P.Monad<Promise> + [result (do T.Monad<Task> + [server (@.server port) + client (@.client []) #################### - _ (@;write localhost port from +0 size client) - [bytes-from from-address from-port] (@;read temp +0 size server) + _ (@.write localhost port from +0 size client) + [bytes-from from-address from-port] (@.read temp +0 size server) #let [from-worked? (and (n/= size bytes-from) - (:: blob;Eq<Blob> = from temp))] + (:: blob.Eq<Blob> = from temp))] #################### - _ (@;write from-address from-port to +0 size server) - [bytes-to to-address to-port] (@;read temp +0 size client) + _ (@.write from-address from-port to +0 size server) + [bytes-to to-address to-port] (@.read temp +0 size client) #let [to-worked? (and (n/= size bytes-to) - (:: blob;Eq<Blob> = to temp) + (:: blob.Eq<Blob> = to temp) (n/= port to-port))] #################### - _ (@;close client) - _ (@;close server)] + _ (@.close client) + _ (@.close server)] (wrap (and from-worked? to-worked?)))] (assert "Can communicate between client and server." - (E;default false result)))) + (E.default false result)))) ))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 26dfa0ac7..2efff3c71 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -1,81 +1,80 @@ -(;module: +(.module: lux (lux (control monad) [io] (concurrency [promise]) [cli #+ program:] [test]) - (test ["_;" lux] - (lux ["_;" cli] - ["_;" host] - ["_;" io] - (time ["_;" instant] - ["_;" duration] - ["_;" date]) - (concurrency ["_;" actor] - ["_;" space] - ["_;" atom] - ["_;" frp] - ["_;" promise] - ["_;" stm]) - (control ["_;" exception] - ["_;" interval] - ["_;" pipe] - ["_;" cont] - ["_;" reader] - ["_;" writer] - ["_;" state] - ["_;" parser]) - (data ["_;" bit] - ["_;" bool] - ["_;" error] - ["_;" ident] - ["_;" identity] - ["_;" maybe] - ["_;" number] - ["_;" product] - ["_;" sum] - ["_;" text] - ["_;" lazy] - ["_;" color] - (number ["_;" ratio] - ["_;" complex]) - (format ["_;" json] - ["_;" xml]) - (coll ["_;" array] - ["_;" dict] - ["_;" list] - ["_;" queue] - ["_;" set] - ["_;" stack] - ["_;" sequence] - ["_;" priority-queue] - ["_;" stream] - (tree ["tree_;" rose] - ["tree_;" zipper]) - (ordered ["ordered_;" dict] - ["ordered_;" set])) - (text ["_;" format] - ["_;" lexer] - ["_;" regex])) - ["_;" math] - (math ["_;" random] - (logic ["_;" continuous] - ["_;" fuzzy])) - (macro ["_;" code] - ["_;" syntax] - (poly ["poly_;" eq] - ["poly_;" functor])) - (type ["_;" implicit] - ["_;" object]) - (lang ["lang_;" syntax] - ["_;" type] - (type ["_;" check])) - (world ["_;" blob] - ["_;" file] - (net ["_;" tcp] - ["_;" udp])) - )) + (test ["_." lux] + (lux ["_." cli] + ["_." host] + ["_." io] + (time ["_." instant] + ["_." duration] + ["_." date]) + (concurrency ["_." actor] + ["_." space] + ["_." atom] + ["_." frp] + ["_." promise] + ["_." stm]) + (control ["_." exception] + ["_." interval] + ["_." pipe] + ["_." cont] + ["_." reader] + ["_." writer] + ["_." state] + ["_." parser]) + (data ["_." bit] + ["_." bool] + ["_." error] + ["_." ident] + ["_." identity] + ["_." maybe] + ["_." number] + ["_." product] + ["_." sum] + ["_." text] + ["_." lazy] + ["_." color] + (number ["_." ratio] + ["_." complex]) + (format ["_." json] + ["_." xml]) + (coll ["_." array] + ["_." dict] + ["_." list] + ["_." queue] + ["_." set] + ["_." stack] + ["_." sequence] + ["_." priority-queue] + ["_." stream] + (tree ["tree_." rose] + ["tree_." zipper]) + (ordered ["ordered_." dict] + ["ordered_." set])) + (text ["_." format] + ["_." lexer] + ["_." regex])) + ["_." math] + (math ["_." random] + (logic ["_." continuous] + ["_." fuzzy])) + (macro ["_." code] + ["_." syntax] + (poly ["poly_." eq] + ["poly_." functor])) + (type ["_." implicit] + ["_." object]) + (lang ["lang_." syntax] + ["_." type] + (type ["_." check])) + (world ["_." blob] + ["_." file] + (net ["_." tcp] + ["_." udp])))) (lux (control [contract] [concatenative]) (concurrency [space]) @@ -86,7 +85,7 @@ (format [context] [html] [css]) - (coll (tree ["tree_;" parser]))) + (coll (tree ["tree_." parser]))) (math [random]) [macro] (type [unit]) @@ -95,4 +94,4 @@ ) (program: args - (test;run)) + (test.run)) |