diff options
Diffstat (limited to '')
79 files changed, 995 insertions, 932 deletions
diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux index 94b3d06c8..0a2b6f65c 100644 --- a/stdlib/source/lux/abstract/comonad.lux +++ b/stdlib/source/lux/abstract/comonad.lux @@ -4,7 +4,7 @@ [number ["n" nat]] [collection - ["." list ("#@." fold)]]] + ["." list ("#\." fold)]]] [meta ["." location]]] [// @@ -46,7 +46,7 @@ g!_ (gensym "_") g!map (gensym "map") g!split (gensym "split") - body' (list@fold (: (-> [Code Code] Code Code) + body' (list\fold (: (-> [Code Code] Code Code) (function (_ binding body') (let [[var value] binding] (case var diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux index 2f42c0176..14bbf75f0 100644 --- a/stdlib/source/lux/abstract/monad/indexed.lux +++ b/stdlib/source/lux/abstract/monad/indexed.lux @@ -6,7 +6,7 @@ ["s" code (#+ Parser)]]] [data [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] ["." meta] [macro [syntax (#+ syntax:)] @@ -55,11 +55,11 @@ {context (s.tuple (p.some context))} expression) (meta.with-gensyms [g!_ g!bind] - (let [body (list@fold (function (_ context next) + (let [body (list\fold (function (_ context next) (case context (#Let bindings) (` (let [(~+ (|> bindings - (list@map pair-list) + (list\map pair-list) list.concat))] (~ next))) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 0d21eb9fd..4257818cf 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -8,11 +8,11 @@ [data ["." maybe] ["." product] - ["." text ("#@." monoid)] + ["." text ("#\." monoid)] [number - ["n" nat ("#@." decimal)]] + ["n" nat ("#\." decimal)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] ["." meta] [macro ["." code] @@ -100,23 +100,23 @@ (meta.with-gensyms [g!descriptor] (do meta.monad [current-module meta.current-module-name - #let [descriptor ($_ text@compose "{" current-module "." name "}" text.new-line) + #let [descriptor ($_ text\compose "{" current-module "." name "}" text.new-line) g!self (code.local-identifier name)]] (wrap (list (` (def: (~+ (scw.export export)) (~ g!self) (All [(~+ (scw.type-variables t-vars))] - (..Exception [(~+ (list@map (get@ #sc.input-type) inputs))])) + (..Exception [(~+ (list\map (get@ #sc.input-type) inputs))])) (let [(~ g!descriptor) (~ (code.text descriptor))] {#..label (~ g!descriptor) - #..constructor (function ((~ g!self) [(~+ (list@map (get@ #sc.input-binding) inputs))]) - ((~! text@compose) (~ g!descriptor) + #..constructor (function ((~ g!self) [(~+ (list\map (get@ #sc.input-binding) inputs))]) + ((~! text\compose) (~ g!descriptor) (~ (maybe.default (' "") body))))}))))) ))) (def: (report' entries) (-> (List [Text Text]) Text) (let [header-separator ": " - largest-header-size (list@fold (function (_ [header _] max) + largest-header-size (list\fold (function (_ [header _] max) (n.max (text.size header) max)) 0 entries) @@ -124,21 +124,21 @@ (list.repeat (n.+ (text.size header-separator) largest-header-size)) (text.join-with "") - (text@compose text.new-line))] + (text\compose text.new-line))] (|> entries - (list@map (function (_ [header message]) + (list\map (function (_ [header message]) (let [padding (|> " " (list.repeat (n.- (text.size header) largest-header-size)) (text.join-with ""))] (|> message (text.replace-all text.new-line on-new-line) - ($_ text@compose padding header header-separator))))) + ($_ text\compose padding header header-separator))))) (text.join-with text.new-line)))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) (wrap (list (` ((~! report') (list (~+ (|> entries - (list@map (function (_ [header message]) + (list\map (function (_ [header message]) (` [(~ header) (~ message)]))))))))))) (def: #export (enumerate format entries) @@ -146,8 +146,8 @@ (-> (-> a Text) (List a) Text)) (|> entries list.enumeration - (list@map (function (_ [index entry]) - [(n@encode index) (format entry)])) + (list\map (function (_ [index entry]) + [(n\encode index) (format entry)])) report')) (def: separator diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 259748caa..7397d03e0 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -12,7 +12,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor monoid)]]]]) + ["." list ("#\." functor monoid)]]]]) (type: #export (Parser s a) {#.doc "A generic parser."} @@ -169,7 +169,7 @@ (do ..monad [min (exactly n p) extra (some p)] - (wrap (list@compose min extra)))) + (wrap (list\compose min extra)))) (def: #export (at-most n p) {#.doc "Parse at most N times."} @@ -208,7 +208,7 @@ (#.Some x) (do ! [xs' (some (..and sep p))] - (wrap (#.Cons x (list@map product.right xs')))) + (wrap (#.Cons x (list\map product.right xs')))) ))) (def: #export (not p) diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux index eb1757862..6105b5f5a 100644 --- a/stdlib/source/lux/control/parser/analysis.lux +++ b/stdlib/source/lux/control/parser/analysis.lux @@ -17,7 +17,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [tool [compiler [reference (#+) @@ -32,7 +32,7 @@ (-> (List Analysis) Text) (format text.new-line "Remaining input: " (|> asts - (list@map /.%analysis) + (list\map /.%analysis) (list.interpose " ") (text.join-with "")))) diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 4ed003882..3d1d30564 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -21,7 +21,7 @@ ["." set (#+ Set)]]] [macro ["." template]]] - ["." // ("#@." monad)]) + ["." // ("#\." monad)]) (type: #export Offset Nat) @@ -94,7 +94,7 @@ (def: #export frac (Parser Frac) - (//@map frac.from-bits ..bits/64)) + (//\map frac.from-bits ..bits/64)) (exception: #export (invalid-tag {range Nat} {byte Nat}) (exception.report @@ -124,7 +124,7 @@ (def: #export any (Parser Any) - (//@wrap [])) + (//\wrap [])) (exception: #export (not-a-bit {value Nat}) (exception.report @@ -155,7 +155,7 @@ [(def: #export <name> (Parser Binary) (do //.monad - [size (//@map .nat <bits>)] + [size (//\map .nat <bits>)] (..segment size)))] [binary/8 ..bits/8] @@ -196,7 +196,7 @@ [value valueP] (recur (.inc index) (row.add value output))) - (//@wrap output)))))] + (//\wrap output)))))] [row/8 ..bits/8] [row/16 ..bits/16] diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux index 0c1910d2f..e89b77a16 100644 --- a/stdlib/source/lux/control/parser/cli.lux +++ b/stdlib/source/lux/control/parser/cli.lux @@ -7,8 +7,8 @@ ["." try (#+ Try)]] [data [collection - ["." list ("#@." monoid monad)]] - ["." text ("#@." equivalence) + ["." list ("#\." monoid monad)]] + ["." text ("#\." equivalence) ["%" format (#+ format)]]] [meta (#+ with-gensyms)] [macro @@ -65,7 +65,7 @@ (function (_ inputs) (do try.monad [[remaining raw] (any inputs)] - (if (text@= reference raw) + (if (text\= reference raw) (wrap [remaining []]) (try.fail (format "Missing token: '" reference "'")))))) @@ -166,9 +166,9 @@ (case ((: (~! (..Parser (io.IO .Any))) ((~! do) (~! //.monad) [(~+ (|> args - (list@map (function (_ [binding parser]) + (list\map (function (_ [binding parser]) (list binding parser))) - list@join))] + list\join))] ((~' wrap) (~ initialization+event-loop)))) (~ g!args)) (#.Right [(~ g!_) (~ g!output)]) diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux index f03188e15..2df442a8f 100644 --- a/stdlib/source/lux/control/parser/code.lux +++ b/stdlib/source/lux/control/parser/code.lux @@ -6,7 +6,7 @@ ["." try (#+ Try)]] [data ["." bit] - ["." text ("#@." monoid)] + ["." text ("#\." monoid)] ["." name] [number ["." nat] @@ -14,9 +14,9 @@ ["." rev] ["." frac]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [macro - ["." code ("#@." equivalence)]]] + ["." code ("#\." equivalence)]]] ["." //]) (def: (join-pairs pairs) @@ -31,8 +31,8 @@ (def: (remaining-inputs asts) (-> (List Code) Text) - ($_ text@compose text.new-line "Remaining input: " - (|> asts (list@map code.format) (list.interpose " ") (text.join-with "")))) + ($_ text\compose text.new-line "Remaining input: " + (|> asts (list\map code.format) (list.interpose " ") (text.join-with "")))) (def: #export any {#.doc "Just returns the next input without applying any logic."} @@ -46,9 +46,9 @@ (#try.Success [tokens' t])))) (template [<query> <check> <type> <tag> <eq> <desc>] - [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))] + [(with-expansions [<failure> (as-is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining-inputs tokens))))] (def: #export <query> - {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input."))} + {#.doc (code.text ($_ text\compose "Parses the next " <desc> " input."))} (Parser <type>) (function (_ tokens) (case tokens @@ -86,18 +86,18 @@ (function (_ tokens) (case tokens (#.Cons [token tokens']) - (if (code@= ast token) + (if (code\= ast token) (#try.Success [tokens' []]) - (#try.Failure ($_ text@compose "Expected a " (code.format ast) " but instead got " (code.format token) + (#try.Failure ($_ text\compose "Expected a " (code.format ast) " but instead got " (code.format token) (remaining-inputs tokens)))) _ (#try.Failure "There are no tokens to parse!")))) (template [<query> <check> <tag> <eq> <desc>] - [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))] + [(with-expansions [<failure> (as-is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining-inputs tokens))))] (def: #export <query> - {#.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)."))} (Parser Text) (function (_ tokens) (case tokens @@ -125,7 +125,7 @@ (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] (-> (Parser a) (Parser a))) (function (_ tokens) @@ -133,17 +133,17 @@ (#.Cons [[_ (<tag> members)] tokens']) (case (p members) (#try.Success [#.Nil x]) (#try.Success [tokens' x]) - _ (#try.Failure ($_ text@compose "Parser was expected to fully consume " <desc> (remaining-inputs tokens)))) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " <desc> (remaining-inputs tokens)))) _ - (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining-inputs tokens))))))] [ 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] (-> (Parser a) (Parser a))) (function (_ tokens) @@ -151,10 +151,10 @@ (#.Cons [[_ (#.Record pairs)] tokens']) (case (p (join-pairs pairs)) (#try.Success [#.Nil x]) (#try.Success [tokens' x]) - _ (#try.Failure ($_ text@compose "Parser was expected to fully consume record" (remaining-inputs tokens)))) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining-inputs tokens)))) _ - (#try.Failure ($_ text@compose "Cannot parse record" (remaining-inputs tokens)))))) + (#try.Failure ($_ text\compose "Cannot parse record" (remaining-inputs tokens)))))) (def: #export end! {#.doc "Ensures there are no more inputs."} @@ -162,7 +162,7 @@ (function (_ tokens) (case tokens #.Nil (#try.Success [tokens []]) - _ (#try.Failure ($_ text@compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -184,8 +184,8 @@ (#try.Success value) _ - (#try.Failure (text@compose "Unconsumed inputs: " - (|> (list@map code.format unconsumed) + (#try.Failure (text\compose "Unconsumed inputs: " + (|> (list\map code.format unconsumed) (text.join-with ", "))))))) (def: #export (local inputs syntax) diff --git a/stdlib/source/lux/control/parser/json.lux b/stdlib/source/lux/control/parser/json.lux index 48006855b..fe82104d0 100644 --- a/stdlib/source/lux/control/parser/json.lux +++ b/stdlib/source/lux/control/parser/json.lux @@ -7,18 +7,18 @@ ["." exception (#+ exception:)]] [data ["." bit] - ["." text ("#@." equivalence monoid)] + ["." text ("#\." equivalence monoid)] [number ["." frac]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." row] ["." dictionary (#+ Dictionary)]] [format ["/" json (#+ JSON)]]] [macro ["." code]]] - ["." // ("#@." functor)]) + ["." // ("#\." functor)]) (type: #export (Parser a) {#.doc "JSON parser."} @@ -61,7 +61,7 @@ (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> "."))} (Parser <type>) (do //.monad [head ..any] @@ -85,7 +85,7 @@ (template [<test> <check> <type> <equivalence> <tag> <desc>] [(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> (Parser Bit)) (do //.monad [head ..any] @@ -97,7 +97,7 @@ (//.fail (exception.construct ..unexpected-value [head]))))) (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> (Parser Any)) (do //.monad [head ..any] @@ -151,7 +151,7 @@ (#/.Object kvs) (case (|> kvs dictionary.entries - (list@map (function (_ [key value]) + (list\map (function (_ [key value]) (list (#/.String key) value))) list.concat (//.run parser)) @@ -175,7 +175,7 @@ (function (recur inputs) (case inputs (^ (list& (#/.String key) value inputs')) - (if (text@= key field-name) + (if (text\= key field-name) (case (//.run parser (list value)) (#try.Success [#.Nil output]) (#try.Success [inputs' output]) @@ -202,4 +202,4 @@ (|>> (//.and ..string) //.some ..object - (//@map (dictionary.from-list text.hash)))) + (//\map (dictionary.from-list text.hash)))) diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux index 0e42618f6..cdca47d1c 100644 --- a/stdlib/source/lux/control/parser/synthesis.lux +++ b/stdlib/source/lux/control/parser/synthesis.lux @@ -13,9 +13,7 @@ ["n" nat] ["." frac]] ["." text - ["%" format (#+ format)]] - [collection - ["." list ("#@." functor)]]] + ["%" format (#+ format)]]] [tool [compiler [reference (#+) diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux index 114b53deb..aede52006 100644 --- a/stdlib/source/lux/control/parser/text.lux +++ b/stdlib/source/lux/control/parser/text.lux @@ -8,11 +8,11 @@ [data ["." product] ["." maybe] - ["/" text (#+ Char) ("#@." monoid)] + ["/" text (#+ Char) ("#\." monoid)] [number - ["n" nat ("#@." decimal)]] + ["n" nat ("#\." decimal)]] [collection - ["." list ("#@." fold)]]] + ["." list ("#\." fold)]]] [macro ["." code]]] ["." //]) @@ -34,13 +34,13 @@ (exception: #export (unconsumed-input {offset Offset} {tape Text}) (exception.report - ["Offset" (n@encode offset)] - ["Input size" (n@encode (/.size tape))] + ["Offset" (n\encode offset)] + ["Input size" (n\encode (/.size tape))] ["Remaining input" (remaining offset tape)])) (exception: #export (expected-to-fail {offset Offset} {tape Text}) (exception.report - ["Offset" (n@encode offset)] + ["Offset" (n\encode offset)] ["Input" (remaining offset tape)])) (exception: #export cannot-parse) @@ -67,7 +67,7 @@ (do //.monad [offset ..offset slices parser] - (wrap (list@fold (function (_ [slice::basis slice::distance] + (wrap (list\fold (function (_ [slice::basis slice::distance] [total::basis total::distance]) [total::basis ("lux i64 +" slice::distance total::distance)]) {#basis offset @@ -163,14 +163,14 @@ (do //.monad [char any #let [char' (maybe.assume (/.nth 0 char))] - _ (//.assert ($_ /@compose "Character is not within range: " (/.from-code bottom) "-" (/.from-code top)) + _ (//.assert ($_ /\compose "Character is not within range: " (/.from-code bottom) "-" (/.from-code top)) (.and (n.>= bottom char') (n.<= top char')))] (wrap char))) (template [<name> <bottom> <top> <desc>] [(def: #export <name> - {#.doc (code.text ($_ /@compose "Only lex " <desc> " characters."))} + {#.doc (code.text ($_ /\compose "Only lex " <desc> " characters."))} (Parser Text) (..range (char <bottom>) (char <top>)))] @@ -210,7 +210,7 @@ (template [<name> <modifier> <exception> <description-modifier>] [(def: #export (<name> options) - {#.doc (code.text ($_ /@compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} (-> Text (Parser Text)) (function (_ [offset tape]) (case (/.nth offset tape) @@ -229,7 +229,7 @@ (template [<name> <modifier> <exception> <description-modifier>] [(def: #export (<name> options) - {#.doc (code.text ($_ /@compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} (-> Text (Parser Slice)) (function (_ [offset tape]) (case (/.nth offset tape) @@ -275,7 +275,7 @@ (do //.monad [=left left =right right] - (wrap ($_ /@compose =left =right)))) + (wrap ($_ /\compose =left =right)))) (def: #export (and! left right) (-> (Parser Slice) (Parser Slice) (Parser Slice)) @@ -286,7 +286,7 @@ (template [<name> <base> <doc-modifier>] [(def: #export (<name> parser) - {#.doc (code.text ($_ /@compose "Lex " <doc-modifier> " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " characters as a single continuous text."))} (-> (Parser Text) (Parser Text)) (|> parser <base> (:: //.monad map /.concat)))] @@ -296,7 +296,7 @@ (template [<name> <base> <doc-modifier>] [(def: #export (<name> parser) - {#.doc (code.text ($_ /@compose "Lex " <doc-modifier> " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " characters as a single continuous text."))} (-> (Parser Slice) (Parser Slice)) (with-slices (<base> parser)))] @@ -306,7 +306,7 @@ (template [<name> <base> <doc-modifier>] [(def: #export (<name> amount parser) - {#.doc (code.text ($_ /@compose "Lex " <doc-modifier> " N characters."))} + {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " N characters."))} (-> Nat (Parser Text) (Parser Text)) (|> parser (<base> amount) (:: //.monad map /.concat)))] @@ -317,7 +317,7 @@ (template [<name> <base> <doc-modifier>] [(def: #export (<name> amount parser) - {#.doc (code.text ($_ /@compose "Lex " <doc-modifier> " N characters."))} + {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " N characters."))} (-> Nat (Parser Slice) (Parser Slice)) (with-slices (<base> amount parser)))] diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux index f361809e5..c9b8a5c96 100644 --- a/stdlib/source/lux/control/parser/type.lux +++ b/stdlib/source/lux/control/parser/type.lux @@ -7,17 +7,16 @@ ["." exception (#+ exception:)] ["." function]] [data - ["." name ("#@." codec)] [number - ["n" nat ("#@." decimal)]] - ["." text ("#@." monoid) + ["n" nat ("#\." decimal)]] + ["." text ("#\." monoid) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] [macro ["." code]] - ["." type ("#@." equivalence) + ["." type ("#\." equivalence) ["." check]]] ["." //]) @@ -53,7 +52,7 @@ (exception: #export (unconsumed-input {remaining (List Type)}) (exception.report ["Types" (|> remaining - (list@map (|>> %.type (format text.new-line "* "))) + (list\map (|>> %.type (format text.new-line "* "))) (text.join-with ""))])) (type: #export Env @@ -131,7 +130,7 @@ (def: (label idx) (-> Nat Code) - (code.local-identifier ($_ text@compose "label" text.tab (n@encode idx)))) + (code.local-identifier ($_ text\compose "label" text.tab (n\encode idx)))) (def: #export (with-extension type poly) (All [a] (-> Type (Parser a) (Parser [Code a]))) @@ -193,7 +192,7 @@ partial-varI (inc partialI) partial-varL (label partial-varI) partialC (` ((~ funcL) (~+ (|> (list.indices num-args) - (list@map (|>> (n.* 2) inc (n.+ funcI) label)) + (list\map (|>> (n.* 2) inc (n.+ funcI) label)) list.reverse))))] (recur (inc current-arg) (|> env' @@ -235,7 +234,7 @@ (wrap []) (//.fail (exception.construct ..types-do-not-match [expected actual])))))] - [exactly type@=] + [exactly type\=] [sub check.checks?] [super (function.flip check.checks?)] ) diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux index 8ba28d20d..c3d3136c7 100644 --- a/stdlib/source/lux/control/parser/xml.lux +++ b/stdlib/source/lux/control/parser/xml.lux @@ -6,11 +6,11 @@ ["." try (#+ Try)] ["." exception (#+ exception:)]] [data - ["." name ("#@." equivalence codec)] + ["." name ("#\." equivalence codec)] ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list] ["." dictionary]] [format ["/" xml (#+ Attribute Tag XML)]]]] @@ -63,7 +63,7 @@ (exception.throw ..unexpected-input []) (#/.Node _tag _attributes _children) - (if (name@= tag _tag) + (if (name\= tag _tag) (#try.Success [docs []]) (exception.throw ..wrong-tag tag)))))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index e852efca1..bba7317a9 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -12,7 +12,7 @@ ["n" nat] ["i" int]] [collection - ["." list ("#@." fold monad)]]] + ["." list ("#\." fold monad)]]] [meta (#+ with-gensyms)] [macro [syntax (#+ syntax:)] @@ -136,7 +136,7 @@ "Will become: [+50 +2 '+5']")} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] - [(~+ (list@map (function (_ body) (` (|> (~ g!temp) (~+ body)))) + [(~+ (list\map (function (_ body) (` (|> (~ g!temp) (~+ body)))) paths))])))))) (syntax: #export (case> {branches (p.many (p.and s.any s.any))} @@ -156,5 +156,5 @@ +9 "nine" _ "???")))} (wrap (list (` (case (~ prev) - (~+ (list@join (list@map (function (_ [pattern body]) (list pattern body)) + (~+ (list\join (list\map (function (_ [pattern body]) (list pattern body)) branches)))))))) diff --git a/stdlib/source/lux/control/remember.lux b/stdlib/source/lux/control/remember.lux index c2ceb36ee..a0d46979c 100644 --- a/stdlib/source/lux/control/remember.lux +++ b/stdlib/source/lux/control/remember.lux @@ -6,14 +6,14 @@ ["." io] ["." try] ["." exception (#+ exception:)] - ["<>" parser ("#@." functor) + ["<>" parser ("#\." functor) ["<c>" code (#+ Parser)]]] [data ["." text ["%" format (#+ format)]]] [time ["." instant] - ["." date (#+ Date) ("#@." order)]] + ["." date (#+ Date) ("#\." order)]] ["." meta] [macro ["." code] @@ -34,7 +34,7 @@ (def: deadline (Parser Date) ($_ <>.either - (<>@map (|>> instant.from-millis instant.date) + (<>\map (|>> instant.from-millis instant.date) <c>.int) (do <>.monad [raw <c>.text] @@ -48,7 +48,7 @@ (syntax: #export (remember {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) (let [now (io.run instant.now) today (instant.date now)] - (if (date@< deadline today) + (if (date\< deadline today) (wrap (case focus (#.Some focus) (list focus) diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index a2a13eb5a..630b8351f 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -13,7 +13,7 @@ [number ["n" nat]] [collection - ["." list ("#@." fold)]]]]) + ["." list ("#\." fold)]]]]) (def: #export type-name "#Array") @@ -152,7 +152,7 @@ (Array a))) (if (n.= 0 length) dest-array - (list@fold (function (_ offset target) + (list\fold (function (_ offset target) (case (read (n.+ offset src-start) src-array) #.None target @@ -165,7 +165,7 @@ (def: #export (occupancy array) {#.doc "Finds out how many cells in an array are occupied."} (All [a] (-> (Array a) Nat)) - (list@fold (function (_ idx count) + (list\fold (function (_ idx count) (case (read idx array) #.None count @@ -183,7 +183,7 @@ (def: #export (filter! p xs) (All [a] (-> (Predicate a) (Array a) (Array a))) - (list@fold (function (_ idx xs') + (list\fold (function (_ idx xs') (case (read idx xs) #.None xs' @@ -231,7 +231,7 @@ (def: #export (clone xs) (All [a] (-> (Array a) (Array a))) (let [arr-size (size xs)] - (list@fold (function (_ idx ys) + (list\fold (function (_ idx ys) (case (read idx xs) #.None ys @@ -243,7 +243,7 @@ (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]) [(inc idx) (write! idx x arr)]) [0 (new (list.size xs))] xs))) @@ -274,21 +274,21 @@ (#.Cons (maybe.default default (read idx array)) output))))) -(structure: #export (equivalence (^open ",@.")) +(structure: #export (equivalence (^open ",\.")) (All [a] (-> (Equivalence a) (Equivalence (Array a)))) (def: (= xs ys) (let [sxs (size xs) sxy (size ys)] (and (n.= sxy sxs) - (list@fold (function (_ idx prev) + (list\fold (function (_ idx prev) (and prev (case [(read idx xs) (read idx ys)] [#.None #.None] true [(#.Some x) (#.Some y)] - (,@= x y) + (,\= x y) _ false))) @@ -314,7 +314,7 @@ (let [arr-size (size ma)] (if (n.= 0 arr-size) (new arr-size) - (list@fold (function (_ idx mb) + (list\fold (function (_ idx mb) (case (read idx ma) #.None mb diff --git a/stdlib/source/lux/data/collection/bits.lux b/stdlib/source/lux/data/collection/bits.lux index 230b35fa9..7f65fbfd5 100644 --- a/stdlib/source/lux/data/collection/bits.lux +++ b/stdlib/source/lux/data/collection/bits.lux @@ -10,7 +10,7 @@ ["." i64] ["n" nat]] [collection - ["." array (#+ Array) ("#@." fold)]]]]) + ["." array (#+ Array) ("#\." fold)]]]]) (type: #export Chunk I64) @@ -31,7 +31,7 @@ (def: #export (size bits) (-> Bits Nat) - (array@fold (function (_ chunk total) + (array\fold (function (_ chunk total) (|> chunk i64.count (n.+ total))) 0 bits)) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index 34b1d8217..f7a406c45 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -14,8 +14,8 @@ ["." i64] ["n" nat]] [collection - ["." list ("#@." fold functor monoid)] - ["." array (#+ Array) ("#@." functor fold)]]]]) + ["." list ("#\." fold functor monoid)] + ["." array (#+ Array) ("#\." functor fold)]]]]) ## This implementation of Hash Array Mapped Trie (HAMT) is based on ## Clojure's PersistentHashMap implementation. @@ -227,7 +227,7 @@ ## 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] @@ -251,7 +251,7 @@ (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) [(inc base-idx) @@ -508,10 +508,10 @@ (All [k v] (-> (Node k v) Nat)) (case node (#Hierarchy _size hierarchy) - (array@fold n.+ 0 (array@map size' hierarchy)) + (array\fold n.+ 0 (array\map size' hierarchy)) (#Base _ base) - (array@fold n.+ 0 (array@map (function (_ sub-node') + (array\fold n.+ 0 (array\map (function (_ sub-node') (case sub-node' (#.Left sub-node) (size' sub-node) (#.Right _) 1)) @@ -525,15 +525,15 @@ (All [k v] (-> (Node k v) (List [k v]))) (case node (#Hierarchy _size hierarchy) - (array@fold (function (_ sub-node tail) (list@compose (entries' sub-node) tail)) + (array\fold (function (_ sub-node tail) (list\compose (entries' sub-node) tail)) #.Nil hierarchy) (#Base bitmap base) - (array@fold (function (_ branch tail) + (array\fold (function (_ branch tail) (case branch (#.Left sub-node) - (list@compose (entries' sub-node) tail) + (list\compose (entries' sub-node) tail) (#.Right [key' val']) (#.Cons [key' val'] tail))) @@ -541,7 +541,7 @@ base) (#Collisions hash colls) - (array@fold (function (_ [key' val'] tail) (#.Cons [key' val'] tail)) + (array\fold (function (_ [key' val'] tail) (#.Cons [key' val'] tail)) #.Nil colls))) @@ -622,7 +622,7 @@ (def: #export (from-list Hash<k> kvs) (All [k v] (-> (Hash k) (List [k v]) (Dictionary k v))) - (list@fold (function (_ [k v] dict) + (list\fold (function (_ [k v] dict) (put k v dict)) (new Hash<k>) kvs)) @@ -630,7 +630,7 @@ (template [<name> <elem-type> <side>] [(def: #export (<name> dict) (All [k v] (-> (Dictionary k v) (List <elem-type>))) - (|> dict entries (list@map <side>)))] + (|> dict entries (list\map <side>)))] [keys k product.left] [values v product.right] @@ -640,7 +640,7 @@ {#.doc (doc "Merges 2 dictionaries." "If any collisions with keys occur, the values of dict2 will overwrite those of dict1.")} (All [k v] (-> (Dictionary k v) (Dictionary k v) (Dictionary k v))) - (list@fold (function (_ [key val] dict) (put key val dict)) + (list\fold (function (_ [key val] dict) (put key val dict)) dict1 (entries dict2))) @@ -648,7 +648,7 @@ {#.doc (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) (Dictionary k v) (Dictionary k v) (Dictionary k v))) - (list@fold (function (_ [key val2] dict) + (list\fold (function (_ [key val2] dict) (case (get key dict) #.None (put key val2 dict) @@ -673,14 +673,14 @@ {#.doc "Creates a sub-set of the given dict, with only the specified keys."} (All [k v] (-> (List k) (Dictionary k v) (Dictionary k v))) (let [[Hash<k> _] dict] - (list@fold (function (_ key new-dict) + (list\fold (function (_ key new-dict) (case (get key dict) #.None new-dict (#.Some val) (put key val new-dict))) (new Hash<k>) keys))) -(structure: #export (equivalence (^open ",@.")) +(structure: #export (equivalence (^open ",\.")) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v)))) (def: (= reference subject) @@ -689,7 +689,7 @@ (list.every? (function (_ [k rv]) (case (..get k subject) (#.Some sv) - (,@= rv sv) + (,\= rv sv) _ #0)) @@ -701,10 +701,10 @@ (def: (map f fa) (case fa (#Hierarchy size hierarchy) - (#Hierarchy size (array@map (map f) hierarchy)) + (#Hierarchy size (array\map (map f) hierarchy)) (#Base bitmap base) - (#Base bitmap (array@map (function (_ either) + (#Base bitmap (array\map (function (_ either) (case either (#.Left fa') (#.Left (map f fa')) @@ -714,7 +714,7 @@ base)) (#Collisions hash collisions) - (#Collisions hash (array@map (function (_ [k v]) + (#Collisions hash (array\map (function (_ [k v]) [k (f v)]) collisions))))) diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux index f0bacd85a..fc02cd5bf 100644 --- a/stdlib/source/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux @@ -10,7 +10,7 @@ [number ["n" nat]] [collection - ["." list ("#@." monoid fold)]]] + ["." list ("#\." monoid fold)]]] [macro ["." code]]]) @@ -54,7 +54,7 @@ ## TODO: Must improve it as soon as bug is fixed. (def: #export (get key dict) (All [k v] (-> k (Dictionary k v) (Maybe v))) - (let [## (^open "_@.") (get@ #&order dict) + (let [## (^open "_\.") (get@ #&order dict) ] (loop [node (get@ #root dict)] (case node @@ -64,20 +64,20 @@ (#.Some node) (let [node-key (get@ #key node)] (cond (:: dict = node-key key) - ## (_@= node-key key) + ## (_\= node-key key) (#.Some (get@ #value node)) (:: dict < node-key key) - ## (_@< node-key key) + ## (_\< node-key key) (recur (get@ #left node)) - ## (_@> (get@ #key node) key) + ## (_\> (get@ #key node) key) (recur (get@ #right node)))) )))) (def: #export (contains? key dict) (All [k v] (-> k (Dictionary k v) Bit)) - (let [## (^open "_@.") (get@ #&order dict) + (let [## (^open "_\.") (get@ #&order dict) ] (loop [node (get@ #root dict)] (case node @@ -87,9 +87,9 @@ (#.Some node) (let [node-key (get@ #key node)] (or (:: dict = node-key key) - ## (_@= node-key key) + ## (_\= node-key key) (if (:: dict < node-key key) - ## (_@< node-key key) + ## (_\< node-key key) (recur (get@ #left node)) (recur (get@ #right node))))))))) @@ -254,7 +254,7 @@ (def: #export (put key value dict) (All [k v] (-> k v (Dictionary k v) (Dictionary k v))) - (let [(^open "_@.") (get@ #&order dict) + (let [(^open "_\.") (get@ #&order dict) root' (loop [?root (get@ #root dict)] (case ?root #.None @@ -271,11 +271,11 @@ (#.Some (<add> (maybe.assume outcome) root))))] - [_@< #left add-left] + [_\< #left add-left] [(order.> (get@ #&order dict)) #right add-right] )) - ## (_@= reference key) + ## (_\= reference key) (#.Some (set@ #value value root)) ))) ))] @@ -477,7 +477,7 @@ (def: #export (remove key dict) (All [k v] (-> k (Dictionary k v) (Dictionary k v))) - (let [(^open "_@.") (get@ #&order dict) + (let [(^open "_\.") (get@ #&order dict) [?root found?] (loop [?root (get@ #root dict)] (case ?root #.None @@ -486,11 +486,11 @@ (#.Some root) (let [root-key (get@ #key root) root-val (get@ #value root)] - (if (_@= root-key key) + (if (_\= root-key key) [(prepend (get@ #left root) (get@ #right root)) #1] - (let [go-left? (_@< root-key key)] + (let [go-left? (_\< root-key key)] (case (recur (if go-left? (get@ #left root) (get@ #right root))) @@ -541,7 +541,7 @@ (def: #export (from-list Order<l> list) (All [k v] (-> (Order k) (List [k v]) (Dictionary k v))) - (list@fold (function (_ [key value] dict) + (list\fold (function (_ [key value] dict) (put key value dict)) (new Order<l>) list)) @@ -555,7 +555,7 @@ (list) (#.Some node') - ($_ list@compose + ($_ list\compose (recur (get@ #left node')) (list <output>) (recur (get@ #right node'))))))] @@ -565,11 +565,11 @@ [values v (get@ #value node')] ) -(structure: #export (equivalence (^open ",@.")) +(structure: #export (equivalence (^open ",\.")) (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v)))) (def: (= reference sample) - (let [(^open "/@.") (get@ #&order reference)] + (let [(^open "/\.") (get@ #&order reference)] (loop [entriesR (entries reference) entriesS (entries sample)] (case [entriesR entriesS] @@ -577,8 +577,8 @@ #1 [(#.Cons [keyR valueR] entriesR') (#.Cons [keyS valueS] entriesS')] - (and (/@= keyR keyS) - (,@= valueR valueS) + (and (/\= keyR keyS) + (,\= valueR valueS) (recur entriesR' entriesS')) _ diff --git a/stdlib/source/lux/data/collection/dictionary/plist.lux b/stdlib/source/lux/data/collection/dictionary/plist.lux index ae62ee303..2a6037c09 100644 --- a/stdlib/source/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/lux/data/collection/dictionary/plist.lux @@ -4,9 +4,9 @@ ["." equivalence (#+ Equivalence)]] [data ["." product] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [collection - ["." list ("#@." functor)]] + ["." list ("#\." functor)]] [number ["n" nat]]]]) @@ -32,14 +32,14 @@ #.None (#.Cons [k' v'] properties') - (if (text@= key k') + (if (text\= key k') (#.Some v') (get key properties')))) (template [<name> <type> <access>] [(def: #export <name> (All [a] (-> (PList a) (List <type>))) - (list@map <access>))] + (list\map <access>))] [keys Text product.left] [values a product.right] @@ -61,7 +61,7 @@ (list [key val]) (#.Cons [k' v'] properties') - (if (text@= key k') + (if (text\= key k') (#.Cons [key val] properties') (#.Cons [k' v'] @@ -74,7 +74,7 @@ #.Nil (#.Cons [k' v'] properties') - (if (text@= key k') + (if (text\= key k') (#.Cons [k' (f v')] properties') (#.Cons [k' v'] (update key f properties'))))) @@ -85,7 +85,7 @@ properties (#.Cons [k' v'] properties') - (if (text@= key k') + (if (text\= key k') properties' (#.Cons [k' v'] (remove key properties'))))) diff --git a/stdlib/source/lux/data/collection/queue.lux b/stdlib/source/lux/data/collection/queue.lux index b3d384f6d..69e4f7025 100644 --- a/stdlib/source/lux/data/collection/queue.lux +++ b/stdlib/source/lux/data/collection/queue.lux @@ -7,7 +7,7 @@ [number ["n" nat]] [collection - ["." list ("#@." monoid functor)]]]]) + ["." list ("#\." monoid functor)]]]]) (type: #export (Queue a) {#front (List a) @@ -26,7 +26,7 @@ (def: #export (to-list queue) (All [a] (-> (Queue a) (List a))) (let [(^slots [#front #rear]) queue] - (list@compose front (list.reverse rear)))) + (list\compose front (list.reverse rear)))) (def: #export peek (All [a] (-> (Queue a) (Maybe a))) @@ -87,5 +87,5 @@ (Functor Queue) (def: (map f fa) - {#front (|> fa (get@ #front) (list@map f)) - #rear (|> fa (get@ #rear) (list@map f))})) + {#front (|> fa (get@ #front) (list\map f)) + #rear (|> fa (get@ #rear) (list\map f))})) diff --git a/stdlib/source/lux/data/collection/queue/priority.lux b/stdlib/source/lux/data/collection/queue/priority.lux index 36f827f86..9c526d0df 100644 --- a/stdlib/source/lux/data/collection/queue/priority.lux +++ b/stdlib/source/lux/data/collection/queue/priority.lux @@ -6,7 +6,7 @@ [data ["." maybe] [number - ["n" nat ("#@." interval)]] + ["n" nat ("#\." interval)]] [collection ["." tree #_ ["#" finger (#+ Tree)]]]] @@ -16,8 +16,8 @@ (type: #export Priority Nat) -(def: #export max Priority n@top) -(def: #export min Priority n@bottom) +(def: #export max Priority n\top) +(def: #export min Priority n\bottom) (def: builder (tree.builder n.maximum)) diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index e99a49c6f..ae60e87d5 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -21,8 +21,8 @@ ["." i64] ["n" nat]] [collection - ["." list ("#@." fold functor monoid)] - ["." array (#+ Array) ("#@." functor fold)]]] + ["." list ("#\." fold functor monoid)] + ["." array (#+ Array) ("#\." functor fold)]]] [meta (#+ with-gensyms)] [macro ["." code] @@ -175,7 +175,7 @@ (|> hierarchy array.to-list list.reverse - (list@fold (function (_ sub acc) (list@compose (to-list' sub) acc)) + (list\fold (function (_ sub acc) (list\compose (to-list' sub) acc)) #.Nil)))) (type: #export (Row a) @@ -337,12 +337,12 @@ (def: #export (to-list row) (All [a] (-> (Row a) (List a))) - (list@compose (to-list' (#Hierarchy (get@ #root row))) + (list\compose (to-list' (#Hierarchy (get@ #root row))) (to-list' (#Base (get@ #tail row))))) (def: #export from-list (All [a] (-> (List a) (Row a))) - (list@fold ..add ..empty)) + (list\fold ..add ..empty)) (def: #export (member? a/Equivalence row val) (All [a] (-> (Equivalence a) (Row a) a Bit)) @@ -376,10 +376,10 @@ (def: (= v1 v2) (and (n.= (get@ #size v1) (get@ #size v2)) - (let [(^open "node@.") (node-equivalence Equivalence<a>)] - (and (node@= (#Base (get@ #tail v1)) + (let [(^open "node\.") (node-equivalence Equivalence<a>)] + (and (node\= (#Base (get@ #tail v1)) (#Base (get@ #tail v2))) - (node@= (#Hierarchy (get@ #root v1)) + (node\= (#Hierarchy (get@ #root v1)) (#Hierarchy (get@ #root v2)))))))) (structure: node-fold @@ -388,10 +388,10 @@ (def: (fold f init xs) (case xs (#Base base) - (array@fold f init base) + (array\fold f init base) (#Hierarchy hierarchy) - (array@fold (function (_ node init') (fold f init' node)) + (array\fold (function (_ node init') (fold f init' node)) init hierarchy)))) @@ -412,7 +412,7 @@ (def: identity ..empty) (def: (compose xs ys) - (list@fold add xs (..to-list ys)))) + (list\fold add xs (..to-list ys)))) (structure: node-functor (Functor Node) @@ -420,10 +420,10 @@ (def: (map f xs) (case xs (#Base base) - (#Base (array@map f base)) + (#Base (array\map f base)) (#Hierarchy hierarchy) - (#Hierarchy (array@map (map f) hierarchy))))) + (#Hierarchy (array\map (map f) hierarchy))))) (structure: #export functor (Functor Row) @@ -431,8 +431,8 @@ (def: (map f xs) {#level (get@ #level xs) #size (get@ #size xs) - #root (|> xs (get@ #root) (array@map (:: node-functor map f))) - #tail (|> xs (get@ #tail) (array@map f))})) + #root (|> xs (get@ #root) (array\map (:: node-functor map f))) + #tail (|> xs (get@ #tail) (array\map f))})) (structure: #export apply (Apply Row) @@ -461,7 +461,7 @@ (def: #export reverse (All [a] (-> (Row a) (Row a))) - (|>> ..to-list list.reverse (list@fold add ..empty))) + (|>> ..to-list list.reverse (list\fold add ..empty))) (template [<name> <array> <init> <op>] [(def: #export <name> diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index 2b046fee8..e76355fe1 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -16,7 +16,7 @@ [number ["n" nat]] [collection - ["." list ("#@." monad)]]]]) + ["." list ("#\." monad)]]]]) (type: #export (Sequence a) {#.doc "An infinite sequence of values."} @@ -142,7 +142,7 @@ (let [(^sequence& x y z _tail) (some-sequence-func +1 +2 +3)] (func x y z)))} (with-gensyms [g!sequence] - (let [body+ (` (let [(~+ (list@join (list@map (function (_ pattern) + (let [body+ (` (let [(~+ (list\join (list\map (function (_ pattern) (list (` [(~ pattern) (~ g!sequence)]) (` ((~! //.run) (~ g!sequence))))) patterns)))] diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux index 87117196d..6dd536739 100644 --- a/stdlib/source/lux/data/collection/set.lux +++ b/stdlib/source/lux/data/collection/set.lux @@ -10,7 +10,7 @@ ["n" nat]] [collection ["//" dictionary (#+ Dictionary)] - ["." list ("#@." fold)]]]]) + ["." list ("#\." fold)]]]]) (type: #export (Set a) (Dictionary a Any)) @@ -49,7 +49,7 @@ (def: #export (difference sub base) (All [a] (-> (Set a) (Set a) (Set a))) - (list@fold ..remove base (..to-list sub))) + (list\fold ..remove base (..to-list sub))) (def: #export (intersection filter base) (All [a] (-> (Set a) (Set a) (Set a))) @@ -71,7 +71,7 @@ (def: &equivalence ..equivalence) (def: (hash (^@ set [hash _])) - (list@fold (function (_ elem acc) (n.+ (:: hash hash elem) acc)) + (list\fold (function (_ elem acc) (n.+ (:: hash hash elem) acc)) 0 (..to-list set)))) @@ -87,7 +87,7 @@ (def: #export (from-list hash elements) (All [a] (-> (Hash a) (List a) (Set a))) - (list@fold ..add (..new hash) elements)) + (list\fold ..add (..new hash) elements)) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bit)) diff --git a/stdlib/source/lux/data/collection/set/multi.lux b/stdlib/source/lux/data/collection/set/multi.lux index fb9925e98..46578979d 100644 --- a/stdlib/source/lux/data/collection/set/multi.lux +++ b/stdlib/source/lux/data/collection/set/multi.lux @@ -10,7 +10,7 @@ [abstract (#+ abstract: :abstraction :representation ^:representation)]]] ["." // [// - ["." list ("#@." fold monoid)] + ["." list ("#\." fold monoid)] ["." dictionary (#+ Dictionary)] [// ["." maybe] @@ -26,7 +26,7 @@ (def: #export size (All [a] (-> (Set a) Nat)) - (|>> :representation dictionary.values (list@fold n.+ 0))) + (|>> :representation dictionary.values (list\fold n.+ 0))) (def: #export (add multiplicity elem set) (All [a] (-> Nat a (Set a) (Set a))) @@ -59,8 +59,8 @@ (All [a] (-> (Set a) (List a))) (|>> :representation dictionary.entries - (list@fold (function (_ [elem multiplicity] output) - (list@compose (list.repeat multiplicity elem) output)) + (list\fold (function (_ [elem multiplicity] output) + (list\compose (list.repeat multiplicity elem) output)) #.Nil))) (template [<name> <compose>] @@ -74,7 +74,7 @@ (def: #export (intersection parameter (^:representation subject)) (All [a] (-> (Set a) (Set a) (Set a))) - (list@fold (function (_ [elem multiplicity] output) + (list\fold (function (_ [elem multiplicity] output) (..add (n.min (..multiplicity parameter elem) multiplicity) elem @@ -87,7 +87,7 @@ (|> parameter :representation dictionary.entries - (list@fold (function (_ [elem multiplicity] output) + (list\fold (function (_ [elem multiplicity] output) (..remove multiplicity elem output)) subject))) @@ -128,7 +128,7 @@ (def: (hash (^:representation set)) (let [[hash _] set] - (list@fold (function (_ [elem multiplicity] acc) + (list\fold (function (_ [elem multiplicity] acc) (|> elem (:: hash hash) (n.+ multiplicity) (n.+ acc))) 0 (dictionary.entries set))))) @@ -144,7 +144,7 @@ (def: #export (from-list hash subject) (All [a] (-> (Hash a) (List a) (Set a))) - (list@fold (..add 1) (..new hash) subject)) + (list\fold (..add 1) (..new hash) subject)) (def: #export (from-set subject) (All [a] (-> (//.Set a) (Set a))) diff --git a/stdlib/source/lux/data/collection/set/ordered.lux b/stdlib/source/lux/data/collection/set/ordered.lux index 9884a5860..f215f5430 100644 --- a/stdlib/source/lux/data/collection/set/ordered.lux +++ b/stdlib/source/lux/data/collection/set/ordered.lux @@ -5,7 +5,7 @@ [order (#+ Order)]] [data [collection - ["." list ("#@." fold)] + ["." list ("#\." fold)] [dictionary ["/" ordered]]]] [type @@ -50,11 +50,11 @@ (def: #export (from-list &order list) (All [a] (-> (Order a) (List a) (Set a))) - (list@fold add (..new &order) list)) + (list\fold add (..new &order) list)) (def: #export (union left right) (All [a] (-> (Set a) (Set a) (Set a))) - (list@fold ..add right (..to-list left))) + (list\fold ..add right (..to-list left))) (def: #export (intersection left right) (All [a] (-> (Set a) (Set a) (Set a))) diff --git a/stdlib/source/lux/data/collection/tree.lux b/stdlib/source/lux/data/collection/tree.lux index 16c394525..9519ae0b9 100644 --- a/stdlib/source/lux/data/collection/tree.lux +++ b/stdlib/source/lux/data/collection/tree.lux @@ -10,7 +10,7 @@ ["<c>" code (#+ Parser)]]] [data [collection - ["." list ("#@." monad fold)]]] + ["." list ("#\." monad fold)]]] [macro [syntax (#+ syntax:)] ["." code]]]) @@ -22,7 +22,7 @@ (def: #export (flatten tree) (All [a] (-> (Tree a) (List a))) (#.Cons (get@ #value tree) - (list@join (list@map flatten (get@ #children tree))))) + (list\join (list\map flatten (get@ #children tree))))) (def: #export (leaf value) (All [a] (-> a (Tree a))) @@ -57,7 +57,7 @@ 40 {}})))} (wrap (list (` (~ (loop [[value children] root] (` {#value (~ value) - #children (list (~+ (list@map recur children)))}))))))) + #children (list (~+ (list\map recur children)))}))))))) (structure: #export (equivalence super) (All [a] (-> (Equivalence a) (Equivalence (Tree a)))) @@ -71,14 +71,14 @@ (def: (map f fa) {#value (f (get@ #value fa)) - #children (list@map (map f) + #children (list\map (map f) (get@ #children fa))})) (structure: #export fold (Fold Tree) (def: (fold f init tree) - (list@fold (function (_ tree' init') (fold f init' tree')) + (list\fold (function (_ tree' init') (fold f init' tree')) (f (get@ #value tree) init) (get@ #children tree)))) diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux index cfa70718f..9aa593f71 100644 --- a/stdlib/source/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/lux/data/collection/tree/zipper.lux @@ -7,12 +7,12 @@ [monad (#+ do)] ["." equivalence (#+ Equivalence)]] [data - ["." maybe ("#@." monad)] + ["." maybe ("#\." monad)] [text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold monoid)]]]] - ["." // (#+ Tree) ("#@." functor)]) + ["." list ("#\." functor fold monoid)]]]] + ["." // (#+ Tree) ("#\." functor)]) (type: (Family Zipper a) {#parent (Zipper a) @@ -100,12 +100,12 @@ (wrap (let [(^slots [#parent #lefts #rights]) family] (for {@.old (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0))) - (set@ #//.children (list@compose (list.reverse lefts) + (set@ #//.children (list\compose (list.reverse lefts) (#.Cons (get@ #node zipper) rights)))) parent)} (set@ [#node #//.children] - (list@compose (list.reverse lefts) + (list\compose (list.reverse lefts) (#.Cons (get@ #node zipper) rights)) parent)))))) @@ -144,7 +144,7 @@ (#.Some {#family (#.Some (|> family (set@ <side> #.Nil) (update@ <op-side> (|>> (#.Cons (get@ #node zipper)) - (list@compose prevs))))) + (list\compose prevs))))) #node last}))))] [right rightmost #rights #lefts] @@ -274,12 +274,12 @@ (Functor Zipper) (def: (map f (^slots [#family #node])) - {#family (maybe@map (function (_ (^slots [#parent #lefts #rights])) + {#family (maybe\map (function (_ (^slots [#parent #lefts #rights])) {#parent (map f parent) - #lefts (list@map (//@map f) lefts) - #rights (list@map (//@map f) rights)}) + #lefts (list\map (//\map f) lefts) + #rights (list\map (//\map f) rights)}) family) - #node (//@map f node)})) + #node (//\map f node)})) (structure: #export comonad (CoMonad Zipper) @@ -294,10 +294,10 @@ {#//.value (..zip tree) #//.children (|> tree (get@ #//.children) - (list@map tree-splitter))}))] - {#family (maybe@map (function (_ (^slots [#parent #lefts #rights])) + (list\map tree-splitter))}))] + {#family (maybe\map (function (_ (^slots [#parent #lefts #rights])) {#parent (split parent) - #lefts (list@map tree-splitter lefts) - #rights (list@map tree-splitter rights)}) + #lefts (list\map tree-splitter lefts) + #rights (list\map tree-splitter rights)}) family) #node (tree-splitter node)}))) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 1f5c592f3..945f0576c 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -8,10 +8,10 @@ [number ["n" nat] ["." int] - ["." rev ("#@." interval)] + ["." rev ("#\." interval)] ["f" frac]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." math] [type abstract]]) @@ -382,7 +382,7 @@ (-> Spread Nat Color (List Color)) (let [[hue saturation brightness] (to-hsb color) spread (..normalize spread)] - (list@map (function (_ idx) + (list\map (function (_ idx) (from-hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) saturation brightness])) @@ -393,7 +393,7 @@ (let [[hue saturation brightness] (to-hsb color) spread (..normalize spread)] (|> (list.indices variations) - (list@map (|>> inc .int int.frac + (list\map (|>> inc .int int.frac (f.* spread) (f.+ brightness) ..normalize @@ -405,7 +405,7 @@ (def: #export transparent Alpha - rev@bottom) + rev\bottom) (def: #export translucent Alpha @@ -413,7 +413,7 @@ (def: #export opaque Alpha - rev@top) + rev\top) (type: #export Pigment {#color Color diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index 111d6abe8..692dc37ee 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -10,7 +10,7 @@ [pipe (#+ case>)] ["." function] ["." try (#+ Try)] - ["<>" parser ("#@." monad) + ["<>" parser ("#\." monad) ["/" binary (#+ Offset Size Parser)]]] [data ["." product] @@ -24,7 +24,7 @@ ["%" format (#+ format)]] [collection ["." list] - ["." row (#+ Row) ("#@." functor)] + ["." row (#+ Row) ("#\." functor)] ["." set (#+ Set)]]]]) (def: mask @@ -184,13 +184,13 @@ value (if (n.= original-count capped-count) value (|> value row.to-list (list.take capped-count) row.from-list)) - (^open "specification@.") ..monoid + (^open "specification\.") ..monoid [size mutation] (|> value - (row@map valueW) + (row\map valueW) (:: row.fold fold (function (_ post pre) - (specification@compose pre post)) - specification@identity))] + (specification\compose pre post)) + specification\identity))] [(n.+ <size> size) (function (_ [offset binary]) (try.assume diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index a5fbce4d7..62991f6b9 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -3,11 +3,11 @@ ["." function] [data ["." product] - ["." maybe ("#@." functor)] + ["." maybe ("#\." functor)] ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [type abstract] [host @@ -60,7 +60,7 @@ (def: attributes (-> Attributes Text) - (|>> (list@map (function (_ [key val]) + (|>> (list\map (function (_ [key val]) (format key "=" text.double-quote (..sanitize val) text.double-quote))) (text.join-with " "))) @@ -186,7 +186,7 @@ (def: #export (script attributes inline) (-> Attributes (Maybe Script) Meta) (|> inline - (maybe@map js.code) + (maybe\map js.code) (maybe.default "") (..raw "script" attributes))) @@ -254,7 +254,7 @@ (def: (%polygon [first second third extra]) (Format Polygon) (|> (list& first second third extra) - (list@map %coord) + (list\map %coord) (text.join-with ..coord-separator))) (type: #export Shape @@ -290,13 +290,13 @@ (-> Attributes (List [Attributes Shape]) Image Image) ($_ ..and for - (case (list@map (product.uncurry ..area) areas) + (case (list\map (product.uncurry ..area) areas) #.Nil (..empty "map" attributes) (#.Cons head tail) (..tag "map" attributes - (list@fold (function.flip ..and) head tail))))) + (list\fold (function.flip ..and) head tail))))) (template [<name> <tag> <type>] [(def: #export <name> @@ -450,7 +450,7 @@ (def: #export (description-list attributes descriptions) (-> Attributes (List [Content Element]) Element) - (case (list@map (function (_ [term description]) + (case (list\map (function (_ [term description]) ($_ ..and (..term term) (..description description))) @@ -460,7 +460,7 @@ (#.Cons head tail) (..tag "dl" attributes - (list@fold (function.flip ..and) head tail)))) + (list\fold (function.flip ..and) head tail)))) (def: #export p ..paragraph) @@ -512,14 +512,14 @@ (def: #export (table attributes caption columns headers rows footer) (-> Attributes (Maybe Content) (Maybe Column) Header (List Cell) (Maybe Cell) Element) (let [head (..table-head (..table-row headers)) - content (case (list@map table-row rows) + content (case (list\map table-row rows) #.Nil head (#.Cons first rest) (..and head (..table-body - (list@fold (function.flip ..and) first rest)))) + (list\fold (function.flip ..and) first rest)))) content (case footer #.None content diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index a5611a7c3..5f46f997e 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -10,19 +10,19 @@ [control pipe ["." try (#+ Try)] - ["<>" parser ("#@." monad) + ["<>" parser ("#\." monad) ["<.>" text (#+ Parser)]]] [data ["." bit] ["." maybe] ["." product] - ["." text ("#@." equivalence monoid)] + ["." text ("#\." equivalence monoid)] [number ["n" nat] - ["f" frac ("#@." decimal)]] + ["f" frac ("#\." decimal)]] [collection - ["." list ("#@." fold functor)] - ["." row (#+ Row row) ("#@." monad)] + ["." list ("#\." fold functor)] + ["." row (#+ Row row) ("#\." monad)] ["." dictionary (#+ Dictionary)]]] [macro [syntax (#+ syntax:)] @@ -86,7 +86,7 @@ (wrap (list (` (: JSON #..Null)))) [_ (#.Tuple members)] - (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list@map wrapper members)))))))) + (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list\map wrapper members)))))))) [_ (#.Record pairs)] (do {! ..monad} @@ -114,7 +114,7 @@ (#try.Success (dictionary.keys obj)) _ - (#try.Failure ($_ text@compose "Cannot get the fields of a non-object.")))) + (#try.Failure ($_ text\compose "Cannot get the fields of a non-object.")))) (def: #export (get key json) {#.doc "A JSON object field getter."} @@ -126,10 +126,10 @@ (#try.Success value) #.None - (#try.Failure ($_ text@compose "Missing field '" key "' on object."))) + (#try.Failure ($_ text\compose "Missing field '" key "' on object."))) _ - (#try.Failure ($_ text@compose "Cannot get field '" key "' on a non-object.")))) + (#try.Failure ($_ text\compose "Cannot get field '" key "' on a non-object.")))) (def: #export (set key value json) {#.doc "A JSON object field setter."} @@ -139,18 +139,18 @@ (#try.Success (#Object (dictionary.put key value obj))) _ - (#try.Failure ($_ text@compose "Cannot set field '" key "' on a non-object.")))) + (#try.Failure ($_ text\compose "Cannot set field '" key "' on a non-object.")))) (template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) - {#.doc (code.text ($_ text@compose "A JSON object field getter for " <desc> "."))} + {#.doc (code.text ($_ text\compose "A JSON object field getter for " <desc> "."))} (-> Text JSON (Try <type>)) (case (get key json) (#try.Success (<tag> value)) (#try.Success value) (#try.Success _) - (#try.Failure ($_ text@compose "Wrong value type at key: " key)) + (#try.Failure ($_ text\compose "Wrong value type at key: " key)) (#try.Failure error) (#try.Failure error)))] @@ -179,7 +179,7 @@ [(#Array xs) (#Array ys)] (and (n.= (row.size xs) (row.size ys)) - (list@fold (function (_ idx prev) + (list\fold (function (_ idx prev) (and prev (maybe.default #0 (do maybe.monad @@ -191,7 +191,7 @@ [(#Object xs) (#Object ys)] (and (n.= (dictionary.size xs) (dictionary.size ys)) - (list@fold (function (_ [xk xv] prev) + (list\fold (function (_ [xk xv] prev) (and prev (case (dictionary.get xk ys) #.None #0 @@ -226,7 +226,7 @@ (|> raw (text.split 1) maybe.assume product.right)))))) (def: escape "\") -(def: escaped-dq (text@compose ..escape text.double-quote)) +(def: escaped-dq (text\compose ..escape text.double-quote)) (def: format-string (-> String Text) @@ -250,14 +250,14 @@ (def: (format-array format) (-> (-> JSON Text) (-> Array Text)) - (|>> (row@map format) + (|>> (row\map format) row.to-list (text.join-with ..separator) (text.enclose [..open-array ..close-array]))) (def: (format-kv format [key value]) (-> (-> JSON Text) (-> [String JSON] Text)) - ($_ text@compose + ($_ text\compose (..format-string key) ..entry-separator (format value) @@ -266,7 +266,7 @@ (def: (format-object format) (-> (-> JSON Text) (-> Object Text)) (|>> dictionary.entries - (list@map (..format-kv format)) + (list\map (..format-kv format)) (text.join-with ..separator) (text.enclose [..open-object ..close-object]))) @@ -336,8 +336,8 @@ [mark (<text>.one-of "eE") signed?' (<>.parses? (<text>.this "-")) offset (<text>.many <text>.decimal)] - (wrap ($_ text@compose mark (if signed?' "-" "") offset))))] - (case (f@decode ($_ text@compose (if signed? "-" "") digits "." decimals exp)) + (wrap ($_ text\compose mark (if signed?' "-" "") offset))))] + (case (f\decode ($_ text\compose (if signed? "-" "") digits "." decimals exp)) (#try.Failure message) (<>.fail message) @@ -348,32 +348,32 @@ (Parser Text) ($_ <>.either (<>.after (<text>.this "\t") - (<>@wrap text.tab)) + (<>\wrap text.tab)) (<>.after (<text>.this "\b") - (<>@wrap text.back-space)) + (<>\wrap text.back-space)) (<>.after (<text>.this "\n") - (<>@wrap text.new-line)) + (<>\wrap text.new-line)) (<>.after (<text>.this "\r") - (<>@wrap text.carriage-return)) + (<>\wrap text.carriage-return)) (<>.after (<text>.this "\f") - (<>@wrap text.form-feed)) - (<>.after (<text>.this (text@compose "\" text.double-quote)) - (<>@wrap text.double-quote)) + (<>\wrap text.form-feed)) + (<>.after (<text>.this (text\compose "\" text.double-quote)) + (<>\wrap text.double-quote)) (<>.after (<text>.this "\\") - (<>@wrap "\")))) + (<>\wrap "\")))) (def: parse-string (Parser String) (<| (<text>.enclosed [text.double-quote text.double-quote]) (loop [_ []]) (do {! <>.monad} - [chars (<text>.some (<text>.none-of (text@compose "\" text.double-quote))) + [chars (<text>.some (<text>.none-of (text\compose "\" text.double-quote))) stop <text>.peek]) - (if (text@= "\" stop) + (if (text\= "\" stop) (do ! [escaped parse-escaped next-chars (recur [])] - (wrap ($_ text@compose chars escaped next-chars))) + (wrap ($_ text\compose chars escaped next-chars))) (wrap chars)))) (def: (parse-kv parse-json) diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 65e25c528..c18d81d33 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -18,10 +18,10 @@ ["n" nat] ["." i64]] ["." format #_ - ["#" binary (#+ Writer) ("#@." monoid)]] + ["#" binary (#+ Writer) ("#\." monoid)]] [collection - ["." list ("#@." fold)] - ["." row (#+ Row) ("#@." fold)]]] + ["." list ("#\." fold)] + ["." row (#+ Row) ("#\." fold)]]] [time ["." instant (#+ Instant)] ["." duration]] @@ -56,7 +56,7 @@ Nat (|> ..octal-size (list.repeat <size>) - (list@fold n.* 1) + (list\fold n.* 1) inc)) (exception: #export (<exception> {value Nat}) @@ -515,7 +515,7 @@ Nat (|> ..octal-size (list.repeat ..content-size) - (list@fold n.* 1))) + (list\fold n.* 1))) (abstract: #export Content [Big Binary] @@ -720,9 +720,9 @@ (Writer Tar) (let [end-of-archive (binary.create ..end-of-archive-size)] (function (_ tar) - (format@compose (row@fold (function (_ next total) - (format@compose total (..entry-writer next))) - format@identity + (format\compose (row\fold (function (_ next total) + (format\compose total (..entry-writer next))) + format\identity tar) (format.segment ..end-of-archive-size end-of-archive))))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index b64e2eb62..512438c56 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -6,17 +6,17 @@ [codec (#+ Codec)]] [control [try (#+ Try)] - ["p" parser ("#@." monad) - ["l" text (#+ Parser)]]] + ["<>" parser ("#\." monad) + ["<.>" text (#+ Parser)]]] [data ["." product] - ["." name ("#@." equivalence codec)] + ["." name ("#\." equivalence codec)] [number ["n" nat] ["." int]] - ["." text ("#@." equivalence monoid)] + ["." text ("#\." equivalence monoid)] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]]]) (type: #export Tag @@ -28,7 +28,7 @@ (type: #export Attrs (Dictionary Attribute Text)) -(def: #export attrs +(def: #export attributes Attrs (dictionary.new name.hash)) @@ -41,51 +41,52 @@ (def: xml-standard-escape-char^ (Parser 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 text.double-quote)))) + ($_ <>.either + (<>.after (<text>.this "<") (<>\wrap "<")) + (<>.after (<text>.this ">") (<>\wrap ">")) + (<>.after (<text>.this "&") (<>\wrap "&")) + (<>.after (<text>.this "'") (<>\wrap "'")) + (<>.after (<text>.this """) (<>\wrap text.double-quote)) + )) (def: xml-unicode-escape-char^ (Parser Text) - (|> (do p.monad - [hex? (p.maybe (l.this "x")) + (|> (do <>.monad + [hex? (<>.maybe (<text>.this "x")) code (case hex? #.None - (p.codec int.decimal (l.many l.decimal)) + (<>.codec int.decimal (<text>.many <text>.decimal)) (#.Some _) - (p.codec int.decimal (l.many l.hexadecimal)))] + (<>.codec int.decimal (<text>.many <text>.hexadecimal)))] (wrap (|> code .nat text.from-code))) - (p.before (l.this ";")) - (p.after (l.this "&#")))) + (<>.before (<text>.this ";")) + (<>.after (<text>.this "&#")))) (def: xml-escape-char^ (Parser Text) - (p.either xml-standard-escape-char^ - xml-unicode-escape-char^)) + (<>.either xml-standard-escape-char^ + xml-unicode-escape-char^)) (def: xml-char^ (Parser Text) - (p.either (l.none-of ($_ text@compose "<>&'" text.double-quote)) - xml-escape-char^)) + (<>.either (<text>.none-of ($_ text\compose "<>&'" text.double-quote)) + xml-escape-char^)) (def: xml-identifier (Parser Text) - (do p.monad - [head (p.either (l.one-of "_") - l.alpha) - tail (l.some (p.either (l.one-of "_.-") - l.alpha-num))] - (wrap ($_ text@compose head tail)))) + (do <>.monad + [head (<>.either (<text>.one-of "_") + <text>.alpha) + tail (<text>.some (<>.either (<text>.one-of "_.-") + <text>.alpha-num))] + (wrap ($_ text\compose head tail)))) (def: namespaced-symbol^ (Parser Name) - (do p.monad + (do <>.monad [first-part xml-identifier - ?second-part (<| p.maybe (p.after (l.this ..namespace-separator)) xml-identifier)] + ?second-part (<| <>.maybe (<>.after (<text>.this ..namespace-separator)) xml-identifier)] (case ?second-part #.None (wrap ["" first-part]) @@ -98,94 +99,94 @@ (def: spaced^ (All [a] (-> (Parser a) (Parser a))) - (let [white-space^ (p.some l.space)] - (|>> (p.before white-space^) - (p.after white-space^)))) + (let [white-space^ (<>.some <text>.space)] + (|>> (<>.before white-space^) + (<>.after white-space^)))) (def: attr-value^ (Parser Text) - (let [value^ (l.some xml-char^)] - (p.either (l.enclosed [text.double-quote text.double-quote] value^) - (l.enclosed ["'" "'"] value^)))) + (let [value^ (<text>.some xml-char^)] + (<>.either (<text>.enclosed [text.double-quote text.double-quote] value^) + (<text>.enclosed ["'" "'"] value^)))) (def: attrs^ (Parser Attrs) - (<| (:: p.monad map (dictionary.from-list name.hash)) - p.some - (p.and (spaced^ attr-name^)) - (p.after (l.this "=")) + (<| (:: <>.monad map (dictionary.from-list name.hash)) + <>.some + (<>.and (spaced^ attr-name^)) + (<>.after (<text>.this "=")) (spaced^ attr-value^))) (def: (close-tag^ expected) (-> Tag (Parser [])) - (do p.monad + (do <>.monad [actual (|> tag^ spaced^ - (p.after (l.this "/")) - (l.enclosed ["<" ">"]))] - (p.assert ($_ text@compose "Close tag does not match open tag." text.new-line - "Expected: " (name@encode expected) text.new-line - " Actual: " (name@encode actual) text.new-line) - (name@= expected actual)))) + (<>.after (<text>.this "/")) + (<text>.enclosed ["<" ">"]))] + (<>.assert ($_ text\compose "Close tag does not match open tag." text.new-line + "Expected: " (name\encode expected) text.new-line + " Actual: " (name\encode actual) text.new-line) + (name\= expected actual)))) (def: comment^ (Parser Text) - (|> (l.not (l.this "--")) - l.some - (l.enclosed ["<--" "-->"]) + (|> (<text>.not (<text>.this "--")) + <text>.some + (<text>.enclosed ["<--" "-->"]) spaced^)) (def: xml-header^ (Parser Attrs) (|> (spaced^ attrs^) - (p.before (l.this "?>")) - (p.after (l.this "<?xml")) + (<>.before (<text>.this "?>")) + (<>.after (<text>.this "<?xml")) spaced^)) (def: cdata^ (Parser Text) - (let [end (l.this "]]>")] - (|> (l.some (l.not end)) - (p.after end) - (p.after (l.this "<![CDATA[")) + (let [end (<text>.this "]]>")] + (|> (<text>.some (<text>.not end)) + (<>.after end) + (<>.after (<text>.this "<![CDATA[")) spaced^))) (def: text^ (Parser XML) - (|> (p.either cdata^ - (l.many xml-char^)) - (p@map (|>> #Text)))) + (|> (<>.either cdata^ + (<text>.many xml-char^)) + (<>\map (|>> #Text)))) (def: xml^ (Parser XML) - (|> (p.rec + (|> (<>.rec (function (_ node^) - (p.either text^ - (spaced^ - (do p.monad - [_ (l.this "<") - tag (spaced^ tag^) - attrs (spaced^ attrs^) - #let [no-children^ (do p.monad - [_ (l.this "/>")] - (wrap (#Node tag attrs (list)))) - with-children^ (do p.monad - [_ (l.this ">") - children (p.some node^) - _ (close-tag^ tag)] - (wrap (#Node tag attrs children)))]] - (p.either no-children^ - with-children^)))))) + (<>.either text^ + (spaced^ + (do <>.monad + [_ (<text>.this "<") + tag (spaced^ tag^) + attrs (spaced^ attrs^) + #let [no-children^ (do <>.monad + [_ (<text>.this "/>")] + (wrap (#Node tag attrs (list)))) + with-children^ (do <>.monad + [_ (<text>.this ">") + children (<>.some node^) + _ (close-tag^ tag)] + (wrap (#Node tag attrs children)))]] + (<>.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^)))) + (<>.before (<>.some comment^)) + (<>.after (<>.some comment^)) + (<>.after (<>.maybe xml-header^)))) -(def: #export read +(def: read (-> Text (Try XML)) - (l.run xml^)) + (<text>.run xml^)) (def: (sanitize-value input) (-> Text Text) @@ -200,7 +201,7 @@ (-> Tag Text) (case namespace "" name - _ ($_ text@compose namespace ..namespace-separator name))) + _ ($_ text\compose namespace ..namespace-separator name))) (def: #export attribute (-> Attribute Text) @@ -210,17 +211,17 @@ (-> Attrs Text) (|> attrs dictionary.entries - (list@map (function (_ [key value]) - ($_ text@compose (..attribute key) "=" text.double-quote (sanitize-value value) text.double-quote))) + (list\map (function (_ [key value]) + ($_ text\compose (..attribute key) "=" text.double-quote (sanitize-value value) text.double-quote))) (text.join-with " "))) (def: xml-header Text - ($_ text@compose "<?xml version=" text.double-quote "1.0" text.double-quote " encoding=" text.double-quote "UTF-8" text.double-quote "?>")) + ($_ text\compose "<?xml version=" text.double-quote "1.0" text.double-quote " encoding=" text.double-quote "UTF-8" text.double-quote "?>")) -(def: #export (write input) +(def: (write input) (-> XML Text) - ($_ text@compose xml-header + ($_ text\compose xml-header (loop [input input] (case input (#Text value) @@ -230,12 +231,12 @@ (let [tag (..tag xml-tag) attrs (if (dictionary.empty? xml-attrs) "" - ($_ text@compose " " (write-attrs xml-attrs)))] + ($_ text\compose " " (write-attrs xml-attrs)))] (if (list.empty? xml-children) - ($_ text@compose "<" tag attrs "/>") - ($_ text@compose "<" tag attrs ">" + ($_ text\compose "<" tag attrs "/>") + ($_ text\compose "<" tag attrs ">" (|> xml-children - (list@map recur) + (list\map recur) (text.join-with "")) "</" tag ">"))))))) @@ -251,11 +252,11 @@ (def: (= reference sample) (case [reference sample] [(#Text reference/value) (#Text sample/value)] - (text@= reference/value sample/value) + (text\= reference/value sample/value) [(#Node reference/tag reference/attrs reference/children) (#Node sample/tag sample/attrs sample/children)] - (and (name@= reference/tag sample/tag) + (and (name\= reference/tag sample/tag) (:: (dictionary.equivalence text.equivalence) = reference/attrs sample/attrs) (n.= (list.size reference/children) (list.size sample/children)) @@ -263,4 +264,4 @@ (list.every? (product.uncurry =)))) _ - #0))) + false))) diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux index e79398021..6d344893c 100644 --- a/stdlib/source/lux/data/name.lux +++ b/stdlib/source/lux/data/name.lux @@ -6,7 +6,7 @@ [order (#+ Order)] [codec (#+ Codec)]] [data - ["." text ("#@." equivalence monoid)] + ["." text ("#\." equivalence monoid)] ["." product]]]) ## (type: Name @@ -34,7 +34,7 @@ (def: &equivalence ..equivalence) (def: (< [moduleP shortP] [moduleS shortS]) - (if (text@= moduleP moduleS) + (if (text\= moduleP moduleS) (:: text.order < shortP shortS) (:: text.order < moduleP moduleS)))) @@ -44,11 +44,11 @@ (def: (encode [module short]) (case module "" short - _ ($_ text@compose module "." short))) + _ ($_ text\compose module "." short))) (def: (decode input) - (if (text@= "" input) - (#.Left (text@compose "Invalid format for Name: " input)) + (if (text\= "" input) + (#.Left (text\compose "Invalid format for Name: " input)) (case (text.split-all-with "." input) (^ (list short)) (#.Right ["" short]) @@ -57,4 +57,4 @@ (#.Right [module short]) _ - (#.Left (text@compose "Invalid format for Name: " input)))))) + (#.Left (text\compose "Invalid format for Name: " input)))))) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 17bc1f2b4..8f22aca70 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -16,8 +16,8 @@ ["." product] ["." maybe] [number - ["n" nat ("#@." decimal)]] - ["." text ("#@." monoid)]] + ["n" nat ("#\." decimal)]] + ["." text ("#\." monoid)]] ["." math] [macro ["." code] @@ -97,19 +97,19 @@ (structure: #export codec (Codec Text Ratio) (def: (encode (^slots [#numerator #denominator])) - ($_ text@compose (n@encode numerator) ..separator (n@encode denominator))) + ($_ text\compose (n\encode numerator) ..separator (n\encode denominator))) (def: (decode input) (case (text.split-with ..separator input) (#.Some [num denom]) (do try.monad - [numerator (n@decode num) - denominator (n@decode denom)] + [numerator (n\decode num) + denominator (n\decode denom)] (wrap (normalize {#numerator numerator #denominator denominator}))) #.None - (#.Left (text@compose "Invalid syntax for ratio: " input))))) + (#.Left (text\compose "Invalid syntax for ratio: " input))))) (syntax: #export (ratio numerator {?denominator (p.maybe s.any)}) {#.doc (doc "Rational literals." diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index c82dd5e41..81e6e6bd5 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -14,7 +14,7 @@ ["." i64] ["n" nat]] [collection - ["." list ("#@." fold)]]]]) + ["." list ("#\." fold)]]]]) (type: #export Char Nat) @@ -234,7 +234,7 @@ (def: #export concat (-> (List Text) Text) (let [(^open ".") ..monoid] - (|>> list.reverse (list@fold compose identity)))) + (|>> list.reverse (list\fold compose identity)))) (def: #export (join-with sep texts) (-> Text (List Text) Text) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 24416ea0d..0e21157ba 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -8,7 +8,7 @@ [text ["%" format (#+ format)]] [collection - ["." row (#+ Row) ("#@." fold)]]] + ["." row (#+ Row) ("#\." fold)]]] [compiler ["_" host]] [type @@ -63,7 +63,7 @@ (for {(~~ (static _.old)) (|> buffer :representation product.left)} ## default - (row@fold (function (_ chunk total) + (row\fold (function (_ chunk total) (n.+ (//.size chunk) total)) 0 (:representation buffer)))) @@ -76,7 +76,7 @@ transform java/lang/StringBuilder::toString))} ## default - (row@fold (function (_ chunk total) + (row\fold (function (_ chunk total) (format total chunk)) "" (:representation buffer)))) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 6b9de5402..34aaaaf4e 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -21,7 +21,7 @@ ["." xml] ["." json]] [collection - ["." list ("#@." monad)]]] + ["." list ("#\." monad)]]] [time ["." instant] ["." duration] @@ -83,6 +83,6 @@ (def: #export (list formatter) (All [a] (-> (Format a) (Format (List a)))) - (|>> (list@map (|>> formatter (format " "))) + (|>> (list\map (|>> formatter (format " "))) (text.join-with "") (text.enclose ["(list" ")"]))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index a71498055..863916776 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -4,16 +4,16 @@ monad] [control ["." try] - ["<>" parser ("#@." monad) + ["<>" parser ("#\." monad) ["<t>" text (#+ Parser)] ["<c>" code]]] [data ["." product] ["." maybe] [number (#+ hex) - ["n" nat ("#@." decimal)]] + ["n" nat ("#\." decimal)]] [collection - ["." list ("#@." fold monad)]]] + ["." list ("#\." fold monad)]]] ["." meta (#+ with-gensyms)] [macro [syntax (#+ syntax:)] @@ -47,7 +47,7 @@ (def: (copy reference) (-> Text (Parser Text)) - (<>.after (<t>.this reference) (<>@wrap reference))) + (<>.after (<t>.this reference) (<>\wrap reference))) (def: (join-text^ part^) (-> (Parser (List Text)) (Parser Text)) @@ -70,10 +70,10 @@ (def: (name^ current-module) (-> Text (Parser Name)) ($_ <>.either - (<>.and (<>@wrap current-module) (<>.after (<t>.this "..") name-part^)) + (<>.and (<>\wrap current-module) (<>.after (<t>.this "..") name-part^)) (<>.and name-part^ (<>.after (<t>.this ".") name-part^)) - (<>.and (<>@wrap "lux") (<>.after (<t>.this ".") name-part^)) - (<>.and (<>@wrap "") name-part^))) + (<>.and (<>\wrap "lux") (<>.after (<t>.this ".") name-part^)) + (<>.and (<>\wrap "") name-part^))) (def: (re-var^ current-module) (-> Text (Parser Code)) @@ -118,7 +118,7 @@ [_ (wrap []) init re-user-class^' rest (<>.some (<>.after (<t>.this "&&") (<t>.enclosed ["[" "]"] re-user-class^')))] - (wrap (list@fold (function (_ refinement base) + (wrap (list\fold (function (_ refinement base) (` ((~! refine^) (~ refinement) (~ base)))) init rest)))) @@ -194,7 +194,7 @@ (<>.either (do <>.monad [_ (<t>.this "\") id number^] - (wrap (` ((~! ..copy) (~ (code.identifier ["" (n@encode id)])))))) + (wrap (` ((~! ..copy) (~ (code.identifier ["" (n\encode id)])))))) (do <>.monad [_ (<t>.this "\k<") captured-name name-part^ @@ -273,7 +273,7 @@ (re-scoped^ current-module))) #let [g!total (code.identifier ["" "0total"]) g!temp (code.identifier ["" "0temp"]) - [_ names steps] (list@fold (: (-> (Either Code [Re-Group Code]) + [_ names steps] (list\fold (: (-> (Either Code [Re-Group Code]) [Nat (List Code) (List (List Code))] [Nat (List Code) (List (List Code))]) (function (_ part [idx names steps]) @@ -291,7 +291,7 @@ [idx (code.identifier ["" _name])] #.None - [(inc idx) (code.identifier ["" (n@encode idx)])]) + [(inc idx) (code.identifier ["" (n\encode idx)])]) access (if (n.> 0 num-captures) (` ((~! product.left) (~ name!))) name!)] @@ -310,7 +310,7 @@ 0) (` (do <>.monad [(~ (' #let)) [(~ g!total) ""] - (~+ (|> steps list.reverse list@join))] + (~+ (|> steps list.reverse list\join))] ((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))]) )) @@ -365,12 +365,12 @@ tail (<>.some (<>.after (<t>.this "|") sub^))] (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)) (` ($_ ((~ (if capturing? (` (~! |||^)) (` (~! |||_^))))) (~ (prep-alternative head)) - (~+ (list@map prep-alternative tail))))])))) + (~+ (list\map prep-alternative tail))))])))) (def: (re-scoped^ current-module) (-> Text (Parser [Re-Group Code])) diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux index e173034a9..25f213a98 100644 --- a/stdlib/source/lux/data/text/unicode.lux +++ b/stdlib/source/lux/data/text/unicode.lux @@ -5,9 +5,9 @@ ["." interval (#+ Interval)]] [data [number (#+ hex) - ["n" nat ("#@." interval)]] + ["n" nat ("#\." interval)]] [collection - ["." list ("#@." fold functor)] + ["." list ("#\." fold functor)] ["." tree #_ ["#" finger (#+ Tree)]]]] [type (#+ :by-example) @@ -21,7 +21,7 @@ (Monoid Segment) (def: identity - (:abstraction (interval.between n.enum n@top n@bottom))) + (:abstraction (interval.between n.enum n\top n\bottom))) (def: (compose left right) (let [left (:representation left) right (:representation right)] @@ -215,7 +215,7 @@ (def: #export (set [head tail]) (-> [Segment (List Segment)] Set) - (list@fold ..compose (..singleton head) (list@map ..singleton tail))) + (list\fold ..compose (..singleton head) (list\map ..singleton tail))) (def: half/0 (..set [basic-latin diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index cb136f810..847cc9225 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -21,7 +21,7 @@ ["." json]] [collection ["." array] - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [time [instant (#+ Instant)] [duration (#+ Duration)] @@ -74,7 +74,7 @@ (-> Inspector Inspector) (|>> (:coerce (array.Array Any)) array.to-list - (list@map inspect) + (list\map inspect) (text.join-with " ") (text.enclose ["[" "]"]))) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 7eaa97342..6ac155b40 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -236,7 +236,7 @@ 0 ..success-exit-code _ ..failure-exit-code))))) -(def: (claim' coverage condition) +(def: (|cover'| coverage condition) (-> (List Name) Bit Assertion) (let [message (|> coverage (list\map %.name) @@ -247,12 +247,12 @@ [(update@ #actual-coverage (set.union coverage) counters) documentation]))))) -(def: (cover' coverage condition) +(def: (|cover| coverage condition) (-> (List Name) Bit Test) - (|> (claim' coverage condition) + (|> (..|cover'| coverage condition) (:: random.monad wrap))) -(def: (with-cover' coverage test) +(def: (|with-cover| coverage test) (-> (List Name) Test Test) (let [context (|> coverage (list\map %.name) @@ -284,8 +284,8 @@ (.list (~+ coverage))) (~ condition)))))))] - [claim ..claim'] - [cover ..cover'] + [cover' ..|cover'|] + [cover ..|cover|] ) (syntax: #export (with-cover {coverage (<c>.tuple (<>.many <c>.any))} @@ -293,7 +293,7 @@ (let [coverage (list\map (function (_ definition) (` ((~! ..reference) (~ definition)))) coverage)] - (wrap (list (` ((~! ..with-cover') + (wrap (list (` ((~! ..|with-cover|) (: (.List .Name) (.list (~+ coverage))) (~ test))))))) diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index 18457f024..33f830703 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -12,9 +12,9 @@ ["<>" parser ["<t>" text (#+ Parser)]]] [data - ["." text ("#@." monoid)] + ["." text ("#\." monoid)] [number - ["n" nat ("#@." decimal)]]] + ["n" nat ("#\." decimal)]]] [type abstract]] [/ @@ -37,8 +37,8 @@ (exception: #export (time-exceeds-a-day {time Nat}) (exception.report - ["Time (in milli-seconds)" (n@encode time)] - ["Maximum (in milli-seconds)" (n@encode (dec limit))])) + ["Time (in milli-seconds)" (n\encode time)] + ["Maximum (in milli-seconds)" (n\encode (dec limit))])) (def: separator ":") @@ -56,9 +56,9 @@ (template [<maximum> <parser> <exception> <sub-parser>] [(exception: #export (<exception> {value Nat}) (exception.report - ["Value" (n@encode value)] - ["Minimum" (n@encode 0)] - ["Maximum" (n@encode (dec <maximum>))])) + ["Value" (n\encode value)] + ["Minimum" (n\encode 0)] + ["Maximum" (n\encode (dec <maximum>))])) (def: <parser> (Parser Nat) @@ -148,8 +148,8 @@ (def: (pad value) (-> Nat Text) (if (n.< 10 value) - (text@compose "0" (n@encode value)) - (n@encode value))) + (text\compose "0" (n\encode value)) + (n\encode value))) (def: (adjust-negative space duration) (-> Duration Duration Duration) @@ -160,10 +160,10 @@ (def: (encode-millis millis) (-> Nat Text) (cond (n.= 0 millis) "" - (n.< 10 millis) ($_ text@compose ".00" (n@encode millis)) - (n.< 100 millis) ($_ text@compose ".0" (n@encode millis)) + (n.< 10 millis) ($_ text\compose ".00" (n\encode millis)) + (n.< 100 millis) ($_ text\compose ".0" (n\encode millis)) ## (n.< 1,000 millis) - ($_ text@compose "." (n@encode millis)))) + ($_ text\compose "." (n\encode millis)))) (def: (encode time) (-> Time Text) @@ -171,7 +171,7 @@ [hours time] [(duration.query duration.hour time) (duration.frame duration.hour time)] [minutes time] [(duration.query duration.minute time) (duration.frame duration.minute time)] [seconds millis] [(duration.query duration.second time) (duration.frame duration.second time)]] - ($_ text@compose + ($_ text\compose (..pad (.nat hours)) ..separator (..pad (.nat minutes)) ..separator (..pad (.nat seconds)) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index aadd8199b..2963cdeba 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -13,12 +13,12 @@ ["<t>" text (#+ Parser)]]] [data ["." maybe] - ["." text ("#@." monoid)] + ["." text ("#\." monoid)] [number - ["n" nat ("#@." decimal)] + ["n" nat ("#\." decimal)] ["i" int]] [collection - ["." list ("#@." fold)] + ["." list ("#\." fold)] ["." dictionary (#+ Dictionary)]]] [type abstract]] @@ -28,7 +28,7 @@ (def: month-by-number (Dictionary Nat Month) - (list@fold (function (_ month mapping) + (list\fold (function (_ month mapping) (dictionary.put (//month.number month) month mapping)) (dictionary.new n.hash) //month.year)) @@ -50,17 +50,17 @@ (exception: #export (invalid-day {year Year} {month Month} {day Nat}) (exception.report - ["Value" (n@encode day)] - ["Minimum" (n@encode ..minimum-day)] - ["Maximum" (n@encode (..month-days year month))] + ["Value" (n\encode day)] + ["Minimum" (n\encode ..minimum-day)] + ["Maximum" (n\encode (..month-days year month))] ["Year" (:: //year.codec encode year)] - ["Month" (n@encode (//month.number month))])) + ["Month" (n\encode (//month.number month))])) (def: (pad value) (-> Nat Text) - (let [digits (n@encode value)] + (let [digits (n\encode value)] (if (n.< 10 value) - (text@compose "0" digits) + (text\compose "0" digits) digits))) (def: separator @@ -144,9 +144,9 @@ (template [<minimum> <maximum> <parser> <exception>] [(exception: #export (<exception> {value Nat}) (exception.report - ["Value" (n@encode value)] - ["Minimum" (n@encode <minimum>)] - ["Maximum" (n@encode <maximum>)])) + ["Value" (n\encode value)] + ["Minimum" (n\encode <minimum>)] + ["Maximum" (n\encode <maximum>)])) (def: <parser> (Parser Nat) @@ -173,7 +173,7 @@ (def: (encode value) (-> Date Text) - ($_ text@compose + ($_ text\compose (:: //year.codec encode (..year value)) ..separator (..pad (|> value ..month //month.number)) ..separator (..pad (..day-of-month value)))) diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index f38b20ccd..f0bda31ba 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -12,9 +12,9 @@ ["<t>" text (#+ Parser)]]] [data [number - ["." nat ("#@." decimal)] + ["." nat ("#\." decimal)] ["i" int]] - ["." text ("#@." monoid)]] + ["." text ("#\." monoid)]] [type abstract]]) @@ -128,9 +128,9 @@ (def: (encode duration) (if (:: ..equivalence = ..empty duration) - ($_ text@compose + ($_ text\compose ..positive-sign - (nat@encode 0) + (nat\encode 0) milli-second-suffix) (let [signed? (negative? duration) [days time-left] [(query day duration) (frame day duration)] @@ -144,13 +144,13 @@ [minutes time-left] [(query minute time-left) (frame minute time-left)] [seconds time-left] [(query second time-left) (frame second time-left)] millis (to-millis time-left)] - ($_ text@compose + ($_ text\compose (if signed? ..negative-sign ..positive-sign) - (if (i.= +0 days) "" (text@compose (nat@encode (.nat days)) ..day-suffix)) - (if (i.= +0 hours) "" (text@compose (nat@encode (.nat hours)) ..hour-suffix)) - (if (i.= +0 minutes) "" (text@compose (nat@encode (.nat minutes)) ..minute-suffix)) - (if (i.= +0 seconds) "" (text@compose (nat@encode (.nat seconds)) ..second-suffix)) - (if (i.= +0 millis) "" (text@compose (nat@encode (.nat millis)) ..milli-second-suffix)) + (if (i.= +0 days) "" (text\compose (nat\encode (.nat days)) ..day-suffix)) + (if (i.= +0 hours) "" (text\compose (nat\encode (.nat hours)) ..hour-suffix)) + (if (i.= +0 minutes) "" (text\compose (nat\encode (.nat minutes)) ..minute-suffix)) + (if (i.= +0 seconds) "" (text\compose (nat\encode (.nat seconds)) ..second-suffix)) + (if (i.= +0 millis) "" (text\compose (nat\encode (.nat millis)) ..milli-second-suffix)) )))) (def: parser diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux index 3be07b2ca..5994eaf35 100644 --- a/stdlib/source/lux/time/year.lux +++ b/stdlib/source/lux/time/year.lux @@ -11,10 +11,10 @@ ["<>" parser ["<t>" text (#+ Parser)]]] [data - ["." text ("#@." monoid)] + ["." text ("#\." monoid)] [number - ["n" nat ("#@." decimal)] - ["i" int ("#@." decimal)]]] + ["n" nat ("#\." decimal)] + ["i" int ("#\." decimal)]]] [type abstract]]) @@ -104,15 +104,15 @@ (-> Year Text) (let [year (..value year)] (if (i.< +0 year) - (i@encode year) - (n@encode (.nat year))))) + (i\encode year) + (n\encode (.nat year))))) (def: #export parser (Parser Year) (do {! <>.monad} [sign (<>.or (<t>.this "-") (wrap [])) digits (<t>.many <t>.decimal) - raw-year (<>.codec i.decimal (wrap (text@compose "+" digits)))] + raw-year (<>.codec i.decimal (wrap (text\compose "+" digits)))] (<>.lift (..year (case sign (#.Left _) (i.* -1 raw-year) (#.Right _) raw-year))))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index cb03aec35..29409a881 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -5,9 +5,9 @@ [abstract ["." monad (#+ Monad do)]] [control - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try) ("#\." functor)] ["." exception (#+ Exception exception:)] - ["." io (#+ IO) ("#@." functor)] + ["." io (#+ IO) ("#\." functor)] ["." function] [concurrency ["." promise (#+ Promise)] @@ -25,7 +25,7 @@ ["f" frac]] [collection ["." array (#+ Array)] - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] [time ["." instant (#+ Instant)] @@ -144,14 +144,14 @@ (def: move (..can-open - (|>> (!.use (:: file move)) (io@map (try@map async-file)) promise.future)))))) + (|>> (!.use (:: file move)) (io\map (try\map async-file)) promise.future)))))) (def: (async-directory directory) (-> (Directory IO) (Directory Promise)) (`` (structure (~~ (template [<name> <async>] [(def: <name> (..can-query (|>> (!.use (:: directory <name>)) - (io@map (try@map (list@map <async>))) + (io\map (try\map (list\map <async>))) promise.future)))] [files ..async-file] @@ -165,7 +165,7 @@ (`` (structure (~~ (template [<name> <async>] [(def: <name> (..can-open - (|>> (!.use (:: system <name>)) (io@map (try@map <async>)) promise.future)))] + (|>> (!.use (:: system <name>)) (io\map (try\map <async>)) promise.future)))] [file ..async-file] [create-file ..async-file] @@ -592,7 +592,7 @@ (array.to-list subs))] (wrap (|> subs (list.filter product.left) - (list@map (|>> product.right <capability>))))))))] + (list\map (|>> product.right <capability>))))))))] [files Stats::isFile ..file] [directories Stats::isDirectory directory] diff --git a/stdlib/source/lux/world/net/http/response.lux b/stdlib/source/lux/world/net/http/response.lux index b262f3226..ee0d7b005 100644 --- a/stdlib/source/lux/world/net/http/response.lux +++ b/stdlib/source/lux/world/net/http/response.lux @@ -3,7 +3,7 @@ [control [concurrency ["." promise] - ["." frp ("#@." monad)]]] + ["." frp ("#\." monad)]]] [data ["." text ["." encoding]] @@ -11,7 +11,7 @@ ["." html] ["." css (#+ CSS)] ["." context] - ["." json (#+ JSON) ("#@." codec)]]] + ["." json (#+ JSON) ("#\." codec)]]] ["." io] [world ["." binary (#+ Binary)]]] @@ -28,7 +28,7 @@ (def: #export empty (-> Status Response) - (let [body (frp@wrap (encoding.to-utf8 ""))] + (let [body (frp\wrap (encoding.to-utf8 ""))] (function (_ status) [status {#//.headers (|> context.empty @@ -51,7 +51,7 @@ {#//.headers (|> context.empty (header.content-length (binary.size data)) (header.content-type type)) - #//.body (frp@wrap data)}]) + #//.body (frp\wrap data)}]) (def: #export bad-request (-> Text Response) @@ -69,5 +69,5 @@ [text Text mime.utf-8 (<|)] [html html.Document mime.html html.html] [css CSS mime.css css.css] - [json JSON mime.json json@encode] + [json JSON mime.json json\encode] ) diff --git a/stdlib/source/lux/world/service/journal.lux b/stdlib/source/lux/world/service/journal.lux index f4476a37f..22ff08010 100644 --- a/stdlib/source/lux/world/service/journal.lux +++ b/stdlib/source/lux/world/service/journal.lux @@ -7,9 +7,9 @@ [security ["!" capability (#+ capability:)]]] [data - ["." text ("#@." equivalence)]] + ["." text ("#\." equivalence)]] [time - ["." instant (#+ Instant) ("#@." equivalence)]]]) + ["." instant (#+ Instant) ("#\." equivalence)]]]) (type: #export (Entry a) {#what a @@ -29,15 +29,15 @@ (def: bottom start) (def: top end))) -(structure: #export (equivalence (^open "_@.")) +(structure: #export (equivalence (^open "_\.")) (All [a] (-> (Equivalence a) (Equivalence (Entry a)))) (def: (= reference sample) - (and (_@= (get@ #what reference) (get@ #what sample)) - (text@= (get@ #why reference) (get@ #why sample)) - (text@= (get@ #how reference) (get@ #how sample)) - (text@= (get@ #who reference) (get@ #who sample)) - (text@= (get@ #where reference) (get@ #where sample)) - (instant@= (get@ #when reference) (get@ #when sample))))) + (and (_\= (get@ #what reference) (get@ #what sample)) + (text\= (get@ #why reference) (get@ #why sample)) + (text\= (get@ #how reference) (get@ #how sample)) + (text\= (get@ #who reference) (get@ #who sample)) + (text\= (get@ #where reference) (get@ #where sample)) + (instant\= (get@ #when reference) (get@ #when sample))))) (capability: #export (Can-Write ! a) (can-write (Entry a) (! (Try Any)))) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index b954a5d9f..114f79ea0 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -13,7 +13,7 @@ ["?" policy (#+ Context Safety Safe)]] [concurrency ["." stm (#+ Var STM)] - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data ["." product] [number (#+ hex) @@ -23,7 +23,7 @@ ["." encoding]] [collection ["." array (#+ Array)] - ["." list ("#@." fold functor)] + ["." list ("#\." fold functor)] ["." dictionary]]]] [// [environment (#+ Environment)] @@ -150,11 +150,11 @@ (Ex [?] (-> (Sanitizer Command) (Sanitizer Argument) (Policy ?))) (?.with-policy (: (Context Safety Policy) - (function (_ (^open "?@.")) + (function (_ (^open "?\.")) (structure - (def: command (|>> sanitize-command (!.use ?@can-upgrade))) - (def: argument (|>> sanitize-argument (!.use ?@can-upgrade))) - (def: value (!.use ?@can-downgrade))))))) + (def: command (|>> sanitize-command (!.use ?\can-upgrade))) + (def: argument (|>> sanitize-argument (!.use ?\can-upgrade))) + (def: value (!.use ?\can-downgrade))))))) (def: unix-policy (let [replacer (: Replacer @@ -187,7 +187,7 @@ (def: (jvm::arguments-array arguments) (-> (List Argument) (Array java/lang/String)) (product.right - (list@fold (function (_ argument [idx output]) + (list\fold (function (_ argument [idx output]) [(inc idx) (jvm.array-write idx argument output)]) [0 (jvm.array java/lang/String (list.size arguments))] arguments))) @@ -200,7 +200,7 @@ (-> Environment (java/util/Map java/lang/String java/lang/String) (java/util/Map java/lang/String java/lang/String)) - (list@fold (function (_ [key value] target') + (list\fold (function (_ [key value] target') (exec (java/util/Map::put key value target') target')) target @@ -300,7 +300,7 @@ (All [?] (-> (Policy ?) (Safe Command ?) (List (Safe Argument ?)) java/lang/ProcessBuilder)) - (|> (list@map (:: policy value) arguments) + (|> (list\map (:: policy value) arguments) (list& (:: policy value command)) ..jvm::arguments-array java/lang/ProcessBuilder::new)) @@ -316,10 +316,10 @@ #let [builder (if windows? (..jvm::process-builder ..windows-policy (:: ..windows-policy command command) - (list@map (:: ..windows-policy argument) arguments)) + (list\map (:: ..windows-policy argument) arguments)) (..jvm::process-builder ..unix-policy (:: ..unix-policy command command) - (list@map (:: ..unix-policy argument) arguments)))] + (list\map (:: ..unix-policy argument) arguments)))] _ (|> builder (java/lang/ProcessBuilder::directory (java/io/File::new working-directory)) java/lang/ProcessBuilder::environment @@ -404,7 +404,7 @@ (def: execute (..can-execute (function (_ input) - (promise@wrap + (promise\wrap (do try.monad [simulation (simulation input)] (wrap (..mock-process simulation (stm.var init))))))))) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index 8a6712930..f8fd5f4f3 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -37,13 +37,13 @@ (def: version XML - (#_.Node ["" "modelVersion"] _.attrs + (#_.Node ["" "modelVersion"] _.attributes (list (#_.Text "4.0.0")))) (def: (property tag value) (-> Text Text XML) (#_.Node ["" tag] - _.attrs + _.attributes (list (#_.Text value)))) (def: (artifact value) @@ -63,37 +63,37 @@ (|> (list (..property "name" name) (..property "url" url) (..distribution distribution)) - (#_.Node ["" "license"] _.attrs))) + (#_.Node ["" "license"] _.attributes))) (def: repository (-> Address XML) (|>> (..property "url") list - (#_.Node ["" "repository"] _.attrs))) + (#_.Node ["" "repository"] _.attributes))) (def: (dependency value) (-> Dependency XML) (#_.Node ["" "dependency"] - _.attrs + _.attributes (list\compose (..artifact (get@ #//dependency.artifact value)) (list (..property "type" (get@ #//dependency.type value)))))) (def: (group tag) (-> Text (-> (List XML) XML)) - (|>> (#_.Node ["" tag] _.attrs))) + (|>> (#_.Node ["" tag] _.attributes))) (comment (def: scm (-> /.SCM XML) (|>> (..property "url") list - (#_.Node ["" "scm"] _.attrs))) + (#_.Node ["" "scm"] _.attributes))) (def: (organization [name url]) (-> /.Organization XML) (|> (list (..property "name" name) (..property "url" url)) - (#_.Node ["" "organization"] _.attrs))) + (#_.Node ["" "organization"] _.attributes))) (def: (developer-organization [name url]) (-> /.Organization (List XML)) @@ -109,7 +109,7 @@ (template [<name> <type> <tag>] [(def: <name> (-> <type> XML) - (|>> ..developer' (#_.Node ["" <tag>] _.attrs)))] + (|>> ..developer' (#_.Node ["" <tag>] _.attributes)))] [developer /.Developer "developer"] [contributor /.Contributor "contributor"] @@ -133,7 +133,7 @@ (case (get@ #/.identity value) (#.Some identity) (#try.Success - (#_.Node ["" ..project-tag] _.attrs + (#_.Node ["" ..project-tag] _.attributes ($_ list\compose (list ..version) (..artifact identity) diff --git a/stdlib/source/spec/aedifex/repository.lux b/stdlib/source/spec/aedifex/repository.lux index 613bbd407..a660722d9 100644 --- a/stdlib/source/spec/aedifex/repository.lux +++ b/stdlib/source/spec/aedifex/repository.lux @@ -33,17 +33,17 @@ upload!/bad (:: subject upload invalid-identity invalid-artifact //artifact/extension.lux-library expected) download!/bad (:: subject download invalid-artifact //artifact/extension.lux-library)] - (_.claim [/.Repository] - (and (case [upload!/good download!/good] - [(#try.Success _) (#try.Success actual)] - (:: binary.equivalence = expected actual) + (_.cover' [/.Repository] + (and (case [upload!/good download!/good] + [(#try.Success _) (#try.Success actual)] + (:: binary.equivalence = expected actual) - _ - false) - (case [upload!/bad download!/bad] - [(#try.Failure _) (#try.Failure _)] - true - - _ - false)))) + _ + false) + (case [upload!/bad download!/bad] + [(#try.Failure _) (#try.Failure _)] + true + + _ + false)))) )))) diff --git a/stdlib/source/spec/lux/world/console.lux b/stdlib/source/spec/lux/world/console.lux index 93d2c7417..5257785f0 100644 --- a/stdlib/source/spec/lux/world/console.lux +++ b/stdlib/source/spec/lux/world/console.lux @@ -28,25 +28,25 @@ ?close/good (!.use (:: console close) []) ?close/bad (!.use (:: console close) [])] ($_ _.and' - (_.claim [/.Can-Read] - (case [?read ?read-line] - [(#try.Success _) (#try.Success _)] - true + (_.cover' [/.Can-Read] + (case [?read ?read-line] + [(#try.Success _) (#try.Success _)] + true - _ - false)) - (_.claim [/.Can-Write] - (case ?write - (#try.Success _) - true - - _ - false)) - (_.claim [/.Can-Close] - (case [?close/good ?close/bad] - [(#try.Success _) (#try.Failure _)] - true - - _ - false)) + _ + false)) + (_.cover' [/.Can-Write] + (case ?write + (#try.Success _) + true + + _ + false)) + (_.cover' [/.Can-Close] + (case [?close/good ?close/bad] + [(#try.Success _) (#try.Failure _)] + true + + _ + false)) )))))) diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index e0eacbee6..badc674b6 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -41,20 +41,20 @@ [?read (!.use (:: process read) []) ?await (!.use (:: process await) [])] ($_ _.and' - (_.claim [/.Can-Read] - (case ?read - (#try.Success actual) - (text\= expected actual) - - (#try.Failure error) - false)) - (_.claim [/.Can-Wait /.Exit /.normal] - (case ?await - (#try.Success exit) - (i.= /.normal exit) - - (#try.Failure error) - false)) + (_.cover' [/.Can-Read] + (case ?read + (#try.Success actual) + (text\= expected actual) + + (#try.Failure error) + false)) + (_.cover' [/.Can-Wait /.Exit /.normal] + (case ?await + (#try.Success exit) + (i.= /.normal exit) + + (#try.Failure error) + false)) ))) (def: (destroy-test process) @@ -62,19 +62,19 @@ (do promise.monad [?destroy (!.use (:: process destroy) []) ?await (!.use (:: process await) [])] - (_.claim [/.Can-Destroy] - (and (case ?destroy - (#try.Success _) - true - - (#try.Failure error) - false) - (case ?await - (#try.Success _) - false - - (#try.Failure error) - true))))) + (_.cover' [/.Can-Destroy] + (and (case ?destroy + (#try.Success _) + true + + (#try.Failure error) + false) + (case ?await + (#try.Success _) + false + + (#try.Failure error) + true))))) (with-expansions [<shell-coverage> (as-is [/.Can-Execute /.Command /.Argument])] (def: #export (spec shell) @@ -89,11 +89,11 @@ (case [?echo ?sleep] [(#try.Success echo) (#try.Success sleep)] ($_ _.and' - (_.claim <shell-coverage> - true) + (_.cover' <shell-coverage> + true) (..read-test message echo) (..destroy-test sleep)) _ - (_.claim <shell-coverage> - false)))))))) + (_.cover' <shell-coverage> + false)))))))) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 7540b4541..71d9a29bb 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -14,7 +14,8 @@ ["#/." install] ["#/." deploy] ["#/." deps] - ["#/." build]] + ["#/." build] + ["#/." test]] ["#." local] ["#." cache] ["#." dependency @@ -40,6 +41,7 @@ /command/deploy.test /command/deps.test /command/build.test + /command/test.test /local.test /cache.test /dependency.test diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index 7dff44202..81d5fe136 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -101,14 +101,14 @@ (wrap (do promise.monad [wrote! (/.write-one fs dependency expected-package) read! (/.read-one fs dependency)] - (_.claim [/.write-one /.read-one] - (<| (try.default false) - (do try.monad - [_ wrote! - actual-package read!] - (wrap (:: //package.equivalence = - (set@ #//package.origin #//package.Local expected-package) - actual-package))))))))) + (_.cover' [/.write-one /.read-one] + (<| (try.default false) + (do try.monad + [_ wrote! + actual-package read!] + (wrap (:: //package.equivalence = + (set@ #//package.origin #//package.Local expected-package) + actual-package))))))))) (def: plural Test @@ -119,16 +119,16 @@ (wrap (do promise.monad [wrote! (/.write-all fs expected) read! (/.read-all fs (dictionary.keys expected) //dependency/resolution.empty)] - (_.claim [/.write-all /.read-all] - (<| (try.default false) - (do try.monad - [_ wrote! - actual read!] - (wrap (:: //dependency/resolution.equivalence = - (:: dictionary.functor map - (set@ #//package.origin #//package.Local) - expected) - actual))))))))) + (_.cover' [/.write-all /.read-all] + (<| (try.default false) + (do try.monad + [_ wrote! + actual read!] + (wrap (:: //dependency/resolution.equivalence = + (:: dictionary.functor map + (set@ #//package.origin #//package.Local) + expected) + actual))))))))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 5285b7548..ad72b47c4 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -2,8 +2,7 @@ [lux #* ["_" test (#+ Test)] [abstract - [monad (#+ do)] - ["." predicate]] + [monad (#+ do)]] [control ["." try] ["." exception] @@ -12,30 +11,20 @@ [parser ["." environment]]] [data - [text - ["%" format (#+ format)]] [collection - ["." dictionary] - ["." set]]] + ["." dictionary]]] [math - ["." random (#+ Random)]] + ["." random]] [world ["." file] ["." shell]]] ["$." /// #_ - ["#." package] - ["#." artifact] - ["#." dependency #_ - ["#/." resolution]]] + ["#." package]] {#program ["." / ["//#" /// #_ ["#" profile (#+ Profile)] ["#." action] - ["#." pom] - ["#." package] - ["#." cache] - ["#." repository] ["#." artifact ["#/." type]] ["#." dependency @@ -96,32 +85,32 @@ (wrap (do promise.monad [outcome (/.do! environment fs shell ///dependency/resolution.empty (with-target empty-profile))] - (_.claim [/.no-specified-program] - (case outcome - (#try.Success _) - false + (_.cover' [/.no-specified-program] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no-specified-program error))))) + (#try.Failure error) + (exception.match? /.no-specified-program error))))) (wrap (do promise.monad [outcome (/.do! environment fs shell ///dependency/resolution.empty (with-program empty-profile))] - (_.claim [/.no-specified-target] - (case outcome - (#try.Success _) - false + (_.cover' [/.no-specified-target] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no-specified-target error))))) + (#try.Failure error) + (exception.match? /.no-specified-target error))))) (wrap (do promise.monad [outcome (/.do! environment fs shell ///dependency/resolution.empty profile)] - (_.claim [/.Compiler /.no-available-compiler] - (case outcome - (#try.Success _) - false + (_.cover' [/.Compiler /.no-available-compiler] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no-available-compiler error))))) + (#try.Failure error) + (exception.match? /.no-available-compiler error))))) (do ! [lux-version (random.ascii/alpha 5) [_ compiler-package] $///package.random @@ -141,7 +130,7 @@ (dictionary.put compiler-dependency compiler-package))] _ (/.do! environment fs shell resolution profile)] (wrap true))] - (_.claim [/.do! - /.lux-group /.jvm-compiler-name /.js-compiler-name] - (try.default false verdict))))) + (_.cover' [/.do! + /.lux-group /.jvm-compiler-name /.js-compiler-name] + (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index ba9431b95..7246d38a7 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -114,5 +114,5 @@ (not target-exists!/post)) (and sub-exists!/pre (not sub-exists!/post)))))] - (_.claim [/.do!] - (try.default false verdict))))))) + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index b27d3c0a7..52b995f6f 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -125,5 +125,5 @@ deployed-pom! deployed-sha-1! deployed-md5!)))] - (_.claim [/.do!] - (try.default false verdict))))))) + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index ce85a2206..8c19df87f 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -84,5 +84,5 @@ (not (set.member? pre depender-artifact))) (and (dictionary.contains? dependee post) (dictionary.contains? depender post)))))] - (_.claim [/.do!] - (try.default false verdict))))))) + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index bcc6bb039..8982bc941 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -86,16 +86,16 @@ (file.file-exists? promise.monad fs pom-path))] (wrap (and library-exists! pom-exists!)))] - (_.claim [/.do!] - (try.default false verdict))) + (_.cover' [/.do!] + (try.default false verdict))) #.None (do {! promise.monad} [outcome (..execute! fs sample)] - (_.claim [/.do!] - (case outcome - (#try.Success _) - false + (_.cover' [/.do!] + (case outcome + (#try.Success _) + false - (#try.Failure error) - true)))))))) + (#try.Failure error) + true)))))))) diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index dc05cced0..169318589 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -54,14 +54,14 @@ (:: binary.equivalence = expected actual)]] (wrap (and expected-path! expected-content!)))] - (_.claim [/.do!] - (try.default false verdict))) + (_.cover' [/.do!] + (try.default false verdict))) (#try.Failure error) - (_.claim [/.do!] - (case (get@ #///.identity sample) - (#.Some _) - false + (_.cover' [/.do!] + (case (get@ #///.identity sample) + (#.Some _) + false - #.None - true)))))))) + #.None + true)))))))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux new file mode 100644 index 000000000..be1a89c83 --- /dev/null +++ b/stdlib/source/test/aedifex/command/test.lux @@ -0,0 +1,94 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + [concurrency + ["." promise]] + [parser + ["." environment]]] + [data + [collection + ["." dictionary]]] + [math + ["." random]] + [world + ["." file] + ["." shell]]] + ["$." /// #_ + ["#." package]] + {#program + ["." / + ["/#" // #_ + ["#." build] + ["/#" // #_ + ["#" profile (#+ Profile)] + ["#." action] + ["#." artifact + ["#/." type]] + ["#." dependency + ["#/." resolution]]]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [#let [fs (file.mock (:: file.default separator)) + shell (shell.mock + (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (#try.Success + (: (shell.Simulation []) + (structure + (def: (on-read state) + (#try.Failure "on-read")) + (def: (on-error state) + (#try.Failure "on-error")) + (def: (on-write input state) + (#try.Failure "on-write")) + (def: (on-destroy state) + (#try.Failure "on-destroy")) + (def: (on-await state) + (#try.Success [state shell.normal])))))) + [])] + program (random.ascii/alpha 5) + target (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) + #let [empty-profile (: Profile + (:: ///.monoid identity)) + with-target (: (-> Profile Profile) + (set@ #///.target (#.Some target))) + with-program (: (-> Profile Profile) + (set@ #///.program (#.Some program))) + + profile (|> empty-profile + with-program + with-target) + + no-working-directory environment.empty + + environment (dictionary.put "user.dir" working-directory environment.empty)]] + ($_ _.and + (do ! + [lux-version (random.ascii/alpha 5) + [_ compiler-package] $///package.random + #let [jvm-compiler {#///dependency.artifact {#///artifact.group //build.lux-group + #///artifact.name //build.jvm-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library} + js-compiler {#///dependency.artifact {#///artifact.group //build.lux-group + #///artifact.name //build.js-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library}] + compiler-dependency (random.either (wrap jvm-compiler) + (wrap js-compiler))] + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [resolution (|> ///dependency/resolution.empty + (dictionary.put compiler-dependency compiler-package))] + _ (/.do! environment fs shell resolution profile)] + (wrap true))] + (_.cover' [/.do!] + (try.default false verdict))))) + )))) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 0b2fbe2e2..8bd013125 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -164,28 +164,28 @@ [actual-package (/.one (///repository.mock good []) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [/.one] - (case actual-package - (#try.Success actual-package) - (:: ///package.equivalence = - (set@ #///package.origin #///package.Remote expected-package) - actual-package) - - (#try.Failure _) - false)))) + (_.cover' [/.one] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) (~~ (template [<exception> <bad>] [(wrap (do promise.monad [actual-package (/.one (///repository.mock <bad> []) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [<exception>] - (case actual-package - (#try.Failure error) - (exception.match? <exception> error) + (_.cover' [<exception>] + (case actual-package + (#try.Failure error) + (exception.match? <exception> error) - (#try.Success _) - false))))] + (#try.Success _) + false))))] [/.sha-1-does-not-match bad-sha-1] [/.md5-does-not-match bad-md5] @@ -271,28 +271,28 @@ (///repository.mock good [])) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [/.any] - (case actual-package - (#try.Success actual-package) - (:: ///package.equivalence = - (set@ #///package.origin #///package.Remote expected-package) - actual-package) - - (#try.Failure _) - false)))) + (_.cover' [/.any] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) (wrap (do promise.monad [actual-package (/.any (list (///repository.mock bad-sha-1 []) (///repository.mock bad-md5 [])) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [/.cannot-resolve] - (case actual-package - (#try.Failure error) - (exception.match? /.cannot-resolve error) + (_.cover' [/.cannot-resolve] + (case actual-package + (#try.Failure error) + (exception.match? /.cannot-resolve error) - (#try.Success _) - false)))) + (#try.Success _) + false)))) ))) (def: all @@ -343,15 +343,15 @@ (///repository.mock (..single ignored-artifact ignored-package) [])) (list depender) /.empty)] - (_.claim [/.all] - (case resolution - (#try.Success resolution) - (and (dictionary.contains? depender resolution) - (dictionary.contains? dependee resolution) - (not (dictionary.contains? ignored resolution))) + (_.cover' [/.all] + (case resolution + (#try.Success resolution) + (and (dictionary.contains? depender resolution) + (dictionary.contains? dependee resolution) + (not (dictionary.contains? ignored resolution))) - (#try.Failure error) - false)))) + (#try.Failure error) + false)))) ))) (def: #export test diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index c7f6a4282..9f85ea5af 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -57,5 +57,5 @@ (wrap (:: //.equivalence = (update@ #//.sources ..with-default-source expected) actual)))] - (_.claim [/.read] - (try.default false verdict))))))) + (_.cover' [/.read] + (try.default false verdict))))))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index c25d7b07f..0932fba3d 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -97,35 +97,35 @@ (/.poison! actor))) _ (promise.wait 100) result (promise.future (promise.poll read))] - (_.claim [/.poisoned] - (case result - (#.Some error) - (exception.match? /.poisoned error) + (_.cover' [/.poisoned] + (case result + (#.Some error) + (exception.match? /.poisoned error) - #.None - false))))) + #.None + false))))) (wrap (do promise.monad [sent? (promise.future (do io.monad [actor (/.spawn! /.default 0) sent? (/.mail! inc! actor)] (wrap (..mailed? sent?))))] - (_.claim [/.Behavior /.Mail - /.default /.spawn! /.mail!] - sent?))) + (_.cover' [/.Behavior /.Mail + /.default /.spawn! /.mail!] + sent?))) (wrap (do promise.monad [result (promise.future (do io.monad [counter (/.spawn! /.default 0) _ (/.poison! counter)] (/.mail! inc! counter)))] - (_.claim [/.dead] - (case result - (#try.Success outcome) - false + (_.cover' [/.dead] + (case result + (#try.Success outcome) + false - (#try.Failure error) - (exception.match? /.dead error))))) + (#try.Failure error) + (exception.match? /.dead error))))) (let [die! (: (/.Mail Nat) (function (_ state actor) @@ -137,17 +137,17 @@ alive? (/.alive? actor) obituary (/.obituary actor)] (wrap (#try.Success [actor sent? alive? obituary]))))] - (_.claim [/.Obituary /.obituary] - (case result - (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) - (and (..mailed? sent?) - (not alive?) - (exception.match? ..got-wrecked error) - (n.= initial-state state) - (is? die! single-pending-message)) - - _ - false))))) + (_.cover' [/.Obituary /.obituary] + (case result + (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) + (and (..mailed? sent?) + (not alive?) + (exception.match? ..got-wrecked error) + (n.= initial-state state) + (is? die! single-pending-message)) + + _ + false))))) (wrap (do promise.monad [counter (promise.future (/.spawn! ..counter 0)) @@ -158,13 +158,13 @@ (wrap (and (n.= 1 output-1) (n.= 2 output-2) (n.= 3 output-3))))] - (_.claim [/.actor: /.message: /.tell!] - (case result - (#try.Success outcome) - outcome + (_.cover' [/.actor: /.message: /.tell!] + (case result + (#try.Success outcome) + outcome - (#try.Failure error) - false)))) + (#try.Failure error) + false)))) (wrap (do promise.monad [verdict (promise.future @@ -192,8 +192,8 @@ _ false)))))] - (_.claim [/.actor] - verdict))) + (_.cover' [/.actor] + verdict))) (do ! [num-events (:: ! map (|>> (n.% 10) inc) random.nat) events (random.list num-events random.nat) @@ -234,7 +234,7 @@ #.None false)]] - (_.claim [/.observe] - (and (:: (list.equivalence n.equivalence) = expected (row.to-list actual)) - (not died?)))))) + (_.cover' [/.observe] + (and (:: (list.equivalence n.equivalence) = expected (row.to-list actual)) + (not died?)))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index c9b19f1c7..fd5e7be02 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -103,24 +103,24 @@ promise.resolved /.from-promise /.consume)] - (_.claim [/.from-promise /.consume] - (list\= (list sample) - output)))) + (_.cover' [/.from-promise /.consume] + (list\= (list sample) + output)))) (wrap (do promise.monad [output (|> inputs (/.sequential 0) /.consume)] - (_.claim [/.sequential] - (list\= inputs - output)))) + (_.cover' [/.sequential] + (list\= inputs + output)))) (wrap (do promise.monad [output (|> inputs (/.sequential 0) (/.filter n.even?) /.consume)] - (_.claim [/.filter] - (list\= (list.filter n.even? inputs) - output)))) + (_.cover' [/.filter] + (list\= (list.filter n.even? inputs) + output)))) (wrap (do {! promise.monad} [#let [sink (: (Atom (Row Nat)) (atom.atom row.empty)) @@ -140,19 +140,19 @@ atom.read promise.future (:: ! map row.to-list))] - (_.claim [/.Subscriber /.subscribe] - (and (list\= inputs - output) - (list\= output - listened))))) + (_.cover' [/.Subscriber /.subscribe] + (and (list\= inputs + output) + (list\= output + listened))))) (wrap (do promise.monad [actual (/.fold (function (_ input total) (promise.resolved (n.+ input total))) 0 (/.sequential 0 inputs))] - (_.claim [/.fold] - (n.= (list\fold n.+ 0 inputs) - actual)))) + (_.cover' [/.fold] + (n.= (list\fold n.+ 0 inputs) + actual)))) (wrap (do promise.monad [actual (|> inputs (/.sequential 0) @@ -160,9 +160,9 @@ (promise.resolved (n.+ input total))) 0) /.consume)] - (_.claim [/.folds] - (list\= (list.folds n.+ 0 inputs) - actual)))) + (_.cover' [/.folds] + (list\= (list.folds n.+ 0 inputs) + actual)))) (wrap (do promise.monad [actual (|> (list distint/0 distint/0 distint/0 distint/1 @@ -170,9 +170,9 @@ (/.sequential 0) (/.distinct n.equivalence) /.consume)] - (_.claim [/.distinct] - (list\= (list distint/0 distint/1 distint/2) - actual)))) + (_.cover' [/.distinct] + (list\= (list distint/0 distint/1 distint/2) + actual)))) (let [polling-delay 10 wiggle-room (n.* 5 polling-delay) amount-of-polls 5 @@ -185,16 +185,16 @@ _ (promise.schedule total-delay (io.io [])) _ (promise.future (:: sink close)) actual (/.consume channel)] - (_.claim [/.poll] - (and (list.every? (n.= sample) actual) - (n.>= amount-of-polls (list.size actual)))))) + (_.cover' [/.poll] + (and (list.every? (n.= sample) actual) + (n.>= amount-of-polls (list.size actual)))))) (wrap (do promise.monad [#let [[channel sink] (/.periodic polling-delay)] _ (promise.schedule total-delay (io.io [])) _ (promise.future (:: sink close)) actual (/.consume channel)] - (_.claim [/.periodic] - (n.>= amount-of-polls (list.size actual))))))) + (_.cover' [/.periodic] + (n.>= amount-of-polls (list.size actual))))))) (wrap (do promise.monad [#let [max-iterations 10] actual (|> [0 sample] @@ -205,8 +205,8 @@ current]) #.None)))) /.consume)] - (_.claim [/.iterate] - (and (n.= max-iterations (list.size actual)) - (list\= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) - actual))))) + (_.cover' [/.iterate] + (and (n.= max-iterations (list.size actual)) + (list\= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) + actual))))) ))))) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 0dc28819d..852dca607 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -68,97 +68,97 @@ (/.promise []))] resolved? (/.future (resolver expected)) actual promise] - (_.claim [/.Promise /.Resolver /.promise] - (and resolved? - (n.= expected actual))))) + (_.cover' [/.Promise /.Resolver /.promise] + (and resolved? + (n.= expected actual))))) (wrap (do /.monad [actual (/.resolved expected)] - (_.claim [/.resolved] - (n.= expected actual)))) + (_.cover' [/.resolved] + (n.= expected actual)))) (wrap (do /.monad [actual (/.future (io.io expected))] - (_.claim [/.future] - (n.= expected actual)))) + (_.cover' [/.future] + (n.= expected actual)))) (wrap (do /.monad [pre (/.future instant.now) actual (/.schedule to-wait (io.io expected)) post (/.future instant.now)] - (_.claim [/.schedule] - (and (n.= expected actual) - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post))))))) + (_.cover' [/.schedule] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) (wrap (do /.monad [pre (/.future instant.now) _ (/.wait to-wait) post (/.future instant.now)] - (_.claim [/.wait] - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post)))))) + (_.cover' [/.wait] + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post)))))) (wrap (do /.monad [[leftA rightA] (/.and (/.future (io.io leftE)) (/.future (io.io rightE)))] - (_.claim [/.and] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) + (_.cover' [/.and] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) (wrap (do /.monad [pre (/.future instant.now) actual (/.delay to-wait expected) post (/.future instant.now)] - (_.claim [/.delay] - (and (n.= expected actual) - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post))))))) + (_.cover' [/.delay] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) (wrap (do /.monad [?left (/.or (/.delay 100 leftE) (/.delay 200 dummy)) ?right (/.or (/.delay 200 dummy) (/.delay 100 rightE))] - (_.claim [/.or] - (case [?left ?right] - [(#.Left leftA) (#.Right rightA)] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA)) + (_.cover' [/.or] + (case [?left ?right] + [(#.Left leftA) (#.Right rightA)] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA)) - _ - false)))) + _ + false)))) (wrap (do /.monad [leftA (/.either (/.delay 100 leftE) (/.delay 200 dummy)) rightA (/.either (/.delay 200 dummy) (/.delay 100 rightE))] - (_.claim [/.either] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) + (_.cover' [/.either] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) (wrap (do /.monad [?actual (/.future (/.poll (/.resolved expected))) #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] (/.promise []))] ?never (/.future (/.poll promise))] - (_.claim [/.poll] - (case [?actual ?never] - [(#.Some actual) #.None] - (n.= expected actual) + (_.cover' [/.poll] + (case [?actual ?never] + [(#.Some actual) #.None] + (n.= expected actual) - _ - false)))) + _ + false)))) (wrap (do /.monad [yep (/.future (/.resolved? (/.resolved expected))) #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] (/.promise []))] nope (/.future (/.resolved? promise))] - (_.claim [/.resolved?] - (and yep - (not nope))))) + (_.cover' [/.resolved?] + (and yep + (not nope))))) (wrap (do /.monad [?none (/.time-out to-wait (/.delay extra-time dummy)) ?actual (/.time-out extra-time (/.delay to-wait expected))] - (_.claim [/.time-out] - (case [?none ?actual] - [#.None (#.Some actual)] - (n.= expected actual) + (_.cover' [/.time-out] + (case [?none ?actual] + [#.None (#.Some actual)] + (n.= expected actual) - _ - false)))) + _ + false)))) (wrap (do /.monad [#let [box (: (Atom Nat) (atom.atom dummy))] @@ -166,6 +166,6 @@ (atom.write value box)) (/.resolved expected))) actual (/.future (atom.read box))] - (_.claim [/.await] - (n.= expected actual)))) + (_.cover' [/.await] + (n.= expected actual)))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index fa81183cd..d1c6ac1e4 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -35,26 +35,26 @@ #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad [result (promise.time-out 10 (/.wait semaphore))] - (_.claim [/.semaphore] - (case result - (#.Some _) - true + (_.cover' [/.semaphore] + (case result + (#.Some _) + true - #.None - false))))) + #.None + false))))) (do {! random.monad} [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do {! promise.monad} [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore)) result (promise.time-out 10 (/.wait semaphore))] - (_.claim [/.wait] - (case result - (#.Some _) - false + (_.cover' [/.wait] + (case result + (#.Some _) + false - #.None - true))))) + #.None + true))))) (do {! random.monad} [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] @@ -64,25 +64,25 @@ result/0 (promise.time-out 10 block) open-positions (/.signal semaphore) result/1 (promise.time-out 10 block)] - (_.claim [/.signal] - (case [result/0 result/1 open-positions] - [#.None (#.Some _) (#try.Success +0)] - true + (_.cover' [/.signal] + (case [result/0 result/1 open-positions] + [#.None (#.Some _) (#try.Success +0)] + true - _ - false))))) + _ + false))))) (do {! random.monad} [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad [outcome (/.signal semaphore)] - (_.claim [/.semaphore-is-maxed-out] - (case outcome - (#try.Failure error) - (exception.match? /.semaphore-is-maxed-out error) + (_.cover' [/.semaphore-is-maxed-out] + (case outcome + (#try.Failure error) + (exception.match? /.semaphore-is-maxed-out error) - _ - false))))) + _ + false))))) ))) (def: mutex @@ -115,11 +115,11 @@ [_ processA _ processB #let [outcome (io.run (atom.read resource))]] - (_.claim [/.mutex /.synchronize] - (or (text\= (format expected-As expected-Bs) - outcome) - (text\= (format expected-Bs expected-As) - outcome)))))) + (_.cover' [/.mutex /.synchronize] + (or (text\= (format expected-As expected-Bs) + outcome) + (text\= (format expected-Bs expected-As) + outcome)))))) ))) (def: (waiter resource barrier id) @@ -161,12 +161,12 @@ ids)] _ (monad.seq ! waiters) #let [outcome (io.run (atom.read resource))]] - (_.claim [/.barrier /.block] - (and (text.ends-with? ending outcome) - (list.every? (function (_ id) - (text.contains? (%.nat id) outcome)) - ids) - ))))) + (_.cover' [/.barrier /.block] + (and (text.ends-with? ending outcome) + (list.every? (function (_ id) + (text.contains? (%.nat id) outcome)) + ids) + ))))) ))) (def: #export test diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index ca2a0eb92..234c9a64e 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -52,12 +52,12 @@ (wrap (do promise.monad [actual (/.commit (:: /.monad wrap expected))] - (_.claim [/.commit] - (n.= expected actual)))) + (_.cover' [/.commit] + (n.= expected actual)))) (wrap (do promise.monad [actual (/.commit (/.read (/.var expected)))] - (_.claim [/.Var /.var /.read] - (n.= expected actual)))) + (_.cover' [/.Var /.var /.read] + (n.= expected actual)))) (wrap (do promise.monad [actual (let [box (/.var dummy)] (/.commit (do /.monad @@ -68,17 +68,17 @@ [_ (/.write expected box) actual (/.read box)] (wrap (n.= expected actual)))))] - (_.claim [/.write] - (and (n.= expected actual) - verdict)))) + (_.cover' [/.write] + (and (n.= expected actual) + verdict)))) (wrap (do promise.monad [#let [box (/.var dummy)] output (/.commit (do /.monad [_ (/.update (n.+ expected) box)] (/.read box)))] - (_.claim [/.update] - (n.= (n.+ expected dummy) - output)))) + (_.cover' [/.update] + (n.= (n.+ expected dummy) + output)))) (wrap (do promise.monad [#let [box (/.var dummy) [follower sink] (io.run (/.follow box))] @@ -87,17 +87,17 @@ _ (promise.future (:: sink close)) _ (/.commit (/.update (n.* 3) box)) changes (frp.consume follower)] - (_.claim [/.follow] - (:: (list.equivalence n.equivalence) = - (list expected (n.* 2 expected)) - changes)))) + (_.cover' [/.follow] + (:: (list.equivalence n.equivalence) = + (list expected (n.* 2 expected)) + changes)))) (wrap (let [var (/.var 0)] (do {! promise.monad} [_ (|> (list.repeat iterations-per-process []) (list\map (function (_ _) (/.commit (/.update inc var)))) (monad.seq !)) cummulative (/.commit (/.read var))] - (_.claim [/.STM] - (n.= iterations-per-process - cummulative))))) + (_.cover' [/.STM] + (n.= iterations-per-process + cummulative))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index 6d59672ca..7794be1b9 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -39,8 +39,8 @@ (atom.write [execution-time expected] box)))) _ (promise.wait delay) [execution-time actual] (promise.future (atom.read box))] - (_.claim [/.schedule] - (and (i.>= (.int delay) - (duration.to-millis (instant.span reference-time execution-time))) - (n.= expected actual))))) + (_.cover' [/.schedule] + (and (i.>= (.int delay) + (duration.to-millis (instant.span reference-time execution-time))) + (n.= expected actual))))) )))) diff --git a/stdlib/source/test/lux/control/security/capability.lux b/stdlib/source/test/lux/control/security/capability.lux index b102c6a33..f8f757641 100644 --- a/stdlib/source/test/lux/control/security/capability.lux +++ b/stdlib/source/test/lux/control/security/capability.lux @@ -40,6 +40,6 @@ (wrap (let [capability (..can-io (function (_ _) (io.io expected)))] (do promise.monad [actual (/.use (/.async capability) [])] - (_.claim [/.async] - (n.= expected actual))))) + (_.cover' [/.async] + (n.= expected actual))))) ))))) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 13ad42f3f..6206206e3 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -78,8 +78,8 @@ raw-password (random.ascii 10) #let [password (:: policy-0 password raw-password)]] ($_ _.and - (_.with-cover [/.Privacy /.Private - /.Can-Conceal /.Can-Reveal] + (_.with-cover [/.Privacy /.Private /.Can-Conceal /.Can-Reveal + /.Safety /.Safe /.Can-Trust /.Can-Distrust] ($_ _.and (_.with-cover [/.functor] ($functor.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.functor)) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 531326d92..9798625d5 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -10,7 +10,7 @@ ["$." codec]]}] [control pipe - ["E" try] + ["." try] ["p" parser ["</>" xml]]] [data @@ -23,7 +23,7 @@ ["." dictionary] ["." list ("#\." functor)]]] [math - ["r" random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {1 ["." / (#+ XML)]}) @@ -35,81 +35,61 @@ (def: char (Random Nat) - (do {! r.monad} - [idx (|> r.nat (:: ! map (n.% (text.size char-range))))] + (do {! random.monad} + [idx (|> random.nat (:: ! map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) (let [constraint (|>> (n.% top) (n.max bottom))] - (r\map constraint r.nat))) + (random\map constraint random.nat))) (def: (text bottom top) (-> Nat Nat (Random Text)) - (do r.monad + (do random.monad [size (..size bottom top)] - (r.text ..char size))) + (random.text ..char size))) -(def: xml-identifier^ +(def: identifier (Random Name) - (r.and (..text 0 10) - (..text 1 10))) + (random.and (..text 0 10) + (..text 1 10))) (def: #export xml (Random XML) - (r.rec (function (_ xml) - (r.or (..text 1 10) - (do r.monad - [size (..size 0 2)] - ($_ r.and - xml-identifier^ - (r.dictionary name.hash size xml-identifier^ (..text 0 10)) - (r.list size xml))))))) + (random.rec (function (_ xml) + (random.or (..text 1 10) + (do random.monad + [size (..size 0 2)] + ($_ random.and + ..identifier + (random.dictionary name.hash size ..identifier (..text 0 10)) + (random.list size xml))))))) (def: #export test Test - (<| (_.context (%.name (name-of /.XML))) + (<| (_.covering /._) + (_.with-cover [/.XML]) ($_ _.and - ($equivalence.spec /.equivalence ..xml) - ($codec.spec /.equivalence /.codec ..xml) + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..xml)) + (_.with-cover [/.codec] + ($codec.spec /.equivalence /.codec ..xml)) - (do {! r.monad} - [text (..text 1 10) - num-children (|> r.nat (:: ! map (n.% 5))) - children (r.list num-children (..text 1 10)) - tag xml-identifier^ - attribute xml-identifier^ - value (..text 1 10) - #let [node (#/.Node tag - (dictionary.put attribute value /.attrs) - (list\map (|>> #/.Text) children))]] - ($_ _.and - (_.test "Can parse text." - (E.default #0 - (do E.monad - [output (</>.run </>.text - (#/.Text text))] - (wrap (text\= text output))))) - (_.test "Can parse attributes." - (E.default #0 - (do E.monad - [output (</>.run (p.before </>.ignore - (</>.attribute attribute)) - node)] - (wrap (text\= value output))))) - (_.test "Can parse nodes." - (E.default #0 - (do E.monad - [_ (</>.run (p.before </>.ignore - (</>.node tag)) - node)] - (wrap #1)))) - (_.test "Can parse children." - (E.default #0 - (do E.monad - [outputs (</>.run (</>.children (p.some </>.text)) node)] - (wrap (:: (list.equivalence text.equivalence) = - children - outputs))))) - )) + (do {! random.monad} + [(^@ identifier [namespace name]) ..identifier] + (`` ($_ _.and + (~~ (template [<type> <format>] + [(_.cover [<type> <format>] + (and (text\= name (<format> ["" name])) + (let [identifier (<format> identifier)] + (and (text.starts-with? namespace identifier) + (text.ends-with? name identifier)))))] + + [/.Tag /.tag] + [/.Attribute /.attribute] + )) + (_.cover [/.Attrs /.attributes] + (dictionary.empty? /.attributes)) + ))) ))) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index 87f1c9d57..aeba020d5 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -20,7 +20,7 @@ [subject r.nat parameter r.nat extra r.nat - angle r.frac] + angle r.safe-frac] ($_ _.and (_.test "Constant values don't change." (n.= subject diff --git a/stdlib/source/test/lux/world/environment.lux b/stdlib/source/test/lux/world/environment.lux index 2ab284132..28bcfc377 100644 --- a/stdlib/source/test/lux/world/environment.lux +++ b/stdlib/source/test/lux/world/environment.lux @@ -24,8 +24,8 @@ [_ (wrap [])] (wrap (do promise.monad [environment (promise.future /.read)] - (_.claim [/.read] - (and (not (dictionary.empty? environment)) - (|> environment - dictionary.keys - (list.every? (|>> text.empty? not)))))))))) + (_.cover' [/.read] + (and (not (dictionary.empty? environment)) + (|> environment + dictionary.keys + (list.every? (|>> text.empty? not)))))))))) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index dd37f63ba..b7848cba4 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -138,6 +138,6 @@ wrote! destroyed! (i.= exit await))))] - (_.claim [/.async /.Can-Write] - (try.default false verdict))))) + (_.cover' [/.async /.Can-Write] + (try.default false verdict))))) ))) |