diff options
| author | Eduardo Julian | 2020-11-27 00:07:51 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2020-11-27 00:07:51 -0400 |
| commit | 889139602b77e4387a6e8bfbedacc2a08703e976 (patch) | |
| tree | 3a113e298037122e81b5529475bd1e59286f733f /stdlib | |
| parent | dbb658bd7976c073a2bf314f194b36b30c45784b (diff) | |
Re-named lux/data/format/context to lux/control/parser/environment.
Diffstat (limited to 'stdlib')
76 files changed, 846 insertions, 647 deletions
diff --git a/stdlib/source/lux/control/parser/environment.lux b/stdlib/source/lux/control/parser/environment.lux new file mode 100644 index 000000000..7f3630dd1 --- /dev/null +++ b/stdlib/source/lux/control/parser/environment.lux @@ -0,0 +1,39 @@ +(.module: + [lux #* + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." product] + ["." text + ["%" format (#+ format)]] + [collection + ["." dictionary (#+ Dictionary)]]] + [world + ["/" environment]]] + ["." //]) + +(exception: #export (unknown {property /.Property}) + (exception.report + ["Property" (%.text property)])) + +(type: #export (Parser a) + (//.Parser /.Environment a)) + +(def: #export empty + /.Environment + (dictionary.new text.hash)) + +(def: #export (property name) + (-> Text (Parser Text)) + (function (_ environment) + (case (dictionary.get name environment) + (#.Some value) + (exception.return [environment value]) + + #.None + (exception.throw ..unknown name)))) + +(def: #export (run parser environment) + (All [a] (-> (Parser a) /.Environment (Try a))) + (:: try.monad map product.right (parser environment))) diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux index d874785b5..87117196d 100644 --- a/stdlib/source/lux/data/collection/set.lux +++ b/stdlib/source/lux/data/collection/set.lux @@ -60,8 +60,10 @@ (All [a] (Equivalence (Set a))) (def: (= (^@ reference [hash _]) sample) - (:: (list.equivalence (get@ #hash.&equivalence hash)) = - (..to-list reference) (..to-list sample)))) + (and (n.= (..size reference) + (..size sample)) + (list.every? (..member? reference) + (..to-list sample))))) (structure: #export hash (All [a] (Hash (Set a))) diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux deleted file mode 100644 index bc186f8b4..000000000 --- a/stdlib/source/lux/data/format/context.lux +++ /dev/null @@ -1,45 +0,0 @@ -(.module: - [lux #* - [abstract - [monad (#+ do)]] - [control - [parser (#+ Parser)] - ["." try (#+ Try)] - ["ex" exception (#+ exception:)]] - [data - ["." text - ["%" format (#+ format)]] - [collection - ["." dictionary (#+ Dictionary)]]]]) - -(exception: #export (unknown-property {property Text}) - (ex.report ["Property" (%.text property)])) - -(type: #export Context - (Dictionary Text Text)) - -(type: #export (Property a) - (Parser Context a)) - -(def: #export empty - Context - (dictionary.new text.hash)) - -(def: #export (property name) - (-> Text (Property Text)) - (function (_ context) - (case (dictionary.get name context) - (#.Some value) - (ex.return [context value]) - - #.None - (ex.throw unknown-property name)))) - -(def: #export (run context property) - (All [a] (-> Context (Property a) (Try a))) - (case (property context) - (#try.Success [_ output]) - (#try.Success output) - - (#try.Failure error) - (#try.Failure error))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index b71d60f05..b550f9c5a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -13,7 +13,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." fold monoid functor)]]] + ["." list ("#\." fold monoid functor)]]] ["." type ["." check]] ["." meta] @@ -125,7 +125,7 @@ (#.Product _) (|> caseT type.flatten-tuple - (list@map (re-quantify envs)) + (list\map (re-quantify envs)) type.tuple (:: ///.monad wrap)) @@ -194,16 +194,16 @@ num-sub-patterns (list.size sub-patterns) matches (cond (n.< num-subs num-sub-patterns) (let [[prefix suffix] (list.split (dec num-sub-patterns) subs)] - (list.zip/2 (list@compose prefix (list (type.tuple suffix))) sub-patterns)) + (list.zip/2 (list\compose prefix (list (type.tuple suffix))) sub-patterns)) (n.> num-subs num-sub-patterns) (let [[prefix suffix] (list.split (dec num-subs) sub-patterns)] - (list.zip/2 subs (list@compose prefix (list (code.tuple suffix))))) + (list.zip/2 subs (list\compose prefix (list (code.tuple suffix))))) ## (n.= num-subs num-sub-patterns) (list.zip/2 subs sub-patterns))] (do ! - [[memberP+ thenA] (list@fold (: (All [a] + [[memberP+ thenA] (list\fold (: (All [a] (-> [Type Code] (Operation [(List Pattern) a]) (Operation [(List Pattern) a]))) (function (_ [memberT memberC] then) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux index 9d1c396e9..adf935a89 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux @@ -4,23 +4,23 @@ equivalence ["." monad (#+ do)]] [control - ["." try (#+ Try) ("#@." monad)] + ["." try (#+ Try) ("#\." monad)] ["ex" exception (#+ exception:)]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["." maybe] [number ["n" nat]] ["." text ["%" format (#+ Format format)]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)]]]] ["." //// #_ [// ["/" analysis (#+ Pattern Variant Operation)] [/// - ["#" phase ("#@." monad)]]]]) + ["#" phase ("#\." monad)]]]]) (exception: #export (invalid-tuple-pattern) "Tuple size must be >= 2") @@ -76,7 +76,7 @@ (#Variant ?max-cases cases) (|> cases dictionary.entries - (list@map (function (_ [idx coverage]) + (list\map (function (_ [idx coverage]) (format (%.nat idx) " " (%coverage coverage)))) (text.join-with " ") (text.enclose ["{" "}"]) @@ -97,13 +97,13 @@ (case pattern (^or (#/.Simple #/.Unit) (#/.Bind _)) - (////@wrap #Exhaustive) + (////\wrap #Exhaustive) ## Primitive patterns always have partial coverage because there ## are too many possibilities as far as values go. (^template [<tag>] [(#/.Simple (<tag> _)) - (////@wrap #Partial)]) + (////\wrap #Partial)]) ([#/.Nat] [#/.Int] [#/.Rev] @@ -114,7 +114,7 @@ ## "#0", which means it is possible for bit ## pattern-matching to become exhaustive if complementary parts meet. (#/.Simple (#/.Bit value)) - (////@wrap (#Bit value)) + (////\wrap (#Bit value)) ## Tuple patterns can be exhaustive if there is exhaustiveness for all of ## their sub-patterns. @@ -183,7 +183,7 @@ #1 [(#Bit sideR) (#Bit sideS)] - (bit@= sideR sideS) + (bit\= sideR sideS) [(#Variant allR casesR) (#Variant allS casesS)] (and (n.= (cases allR) @@ -219,12 +219,12 @@ (-> Coverage Coverage (Try Coverage)) (case [addition so-far] [#Partial #Partial] - (try@wrap #Partial) + (try\wrap #Partial) ## 2 bit coverages are exhaustive if they complement one another. (^multi [(#Bit sideA) (#Bit sideSF)] (xor sideA sideSF)) - (try@wrap #Exhaustive) + (try\wrap #Exhaustive) [(#Variant allA casesA) (#Variant allSF casesSF)] (let [addition-cases (cases allSF) @@ -285,7 +285,7 @@ ## The 2 sequences cannot possibly be merged. [#0 #0] - (try@wrap (#Alt so-far addition)) + (try\wrap (#Alt so-far addition)) ## There is nothing the addition adds to the coverage. [#1 #1] @@ -297,7 +297,7 @@ ## The addition completes the coverage. [#Exhaustive _] - (try@wrap #Exhaustive) + (try\wrap #Exhaustive) ## The left part will always match, so the addition is redundant. (^multi [(#Seq left right) single] @@ -307,7 +307,7 @@ ## The right part is not necessary, since it can always match the left. (^multi [single (#Seq left right)] (coverage/= left single)) - (try@wrap single) + (try\wrap single) ## When merging a new coverage against one based on Alt, it may be ## that one of the many coverages in the Alt is complementary to @@ -356,7 +356,7 @@ #.None (case (list.reverse possibilitiesSF) (#.Cons last prevs) - (wrap (list@fold (function (_ left right) (#Alt left right)) + (wrap (list\fold (function (_ left right) (#Alt left right)) last prevs)) @@ -368,4 +368,4 @@ ## The addition cannot possibly improve the coverage. (ex.throw redundant-pattern [so-far addition]) ## There are now 2 alternative paths. - (try@wrap (#Alt so-far addition))))) + (try\wrap (#Alt so-far addition))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 7c4d49340..c278c1065 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -11,7 +11,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." type ["." check]] ["." meta]] @@ -22,7 +22,7 @@ [// ["/" analysis (#+ Tag Analysis Operation Phase)] [/// - ["#" phase ("#@." monad)] + ["#" phase ("#\." monad)] [meta [archive (#+ Archive)]]]]]]) @@ -60,7 +60,7 @@ (-> Nat Type Type Type) (case type (#.Primitive name params) - (#.Primitive name (list@map (replace parameter-idx replacement) params)) + (#.Primitive name (list\map (replace parameter-idx replacement) params)) (^template [<tag>] [(<tag> left right) @@ -78,7 +78,7 @@ (^template [<tag>] [(<tag> env quantified) - (<tag> (list@map (replace parameter-idx replacement) env) + (<tag> (list\map (replace parameter-idx replacement) env) (replace (n.+ 2 parameter-idx) replacement quantified))]) ([#.UnivQ] [#.ExQ]) @@ -181,7 +181,7 @@ (function (recur base) (case base (#.Primitive name parameters) - (#.Primitive name (list@map recur parameters)) + (#.Primitive name (list\map recur parameters)) (^template [<tag>] [(<tag> left right) @@ -195,7 +195,7 @@ (^template [<tag>] [(<tag> environment quantified) - (<tag> (list@map recur environment) quantified)]) + (<tag> (list\map recur environment) quantified)]) ([#.UnivQ] [#.ExQ]) _ @@ -225,7 +225,7 @@ (/.throw ..invalid-type-application inferT)) (#.Product _) - (///@wrap (|> inferT + (///\wrap (|> inferT (type.function (type.flatten-tuple inferT)) (substitute-bound target originalT))) @@ -264,7 +264,7 @@ (n.< boundary tag))) (case (list.nth tag cases) (#.Some caseT) - (///@wrap (if (n.= 0 depth) + (///\wrap (if (n.= 0 depth) (type.function (list caseT) currentT) (let [replace' (replace (|> depth dec (n.* 2)) inferT)] (type.function (list (replace' caseT)) @@ -278,7 +278,7 @@ (n.= boundary tag) (let [caseT (type.variant (list.drop boundary cases))] - (///@wrap (if (n.= 0 depth) + (///\wrap (if (n.= 0 depth) (type.function (list caseT) currentT) (let [replace' (replace (|> depth dec (n.* 2)) inferT)] (type.function (list (replace' caseT)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 72e47e33d..a0e141308 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -6,7 +6,7 @@ ["." exception (#+ exception:)]] ["." meta] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]]]] ["." // #_ ["#." scope] @@ -42,7 +42,7 @@ [_ (//type.infer actualT) (^@ def-name [::module ::name]) (///extension.lift (meta.normalize def-name)) current (///extension.lift meta.current-module-name)] - (if (text@= current ::module) + (if (text\= current ::module) <return> (if exported? (do ! diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux index ffa635109..ef4ae5189 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux @@ -6,11 +6,11 @@ ["." try] ["ex" exception (#+ exception:)]] [data - ["." text ("#@." equivalence)] - ["." maybe ("#@." monad)] + ["." text ("#\." equivalence)] + ["." maybe ("#\." monad)] ["." product] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." functor fold monoid)] [dictionary ["." plist]]]]] ["." /// #_ @@ -36,7 +36,7 @@ (|> scope (get@ [#.locals #.mappings]) (plist.get name) - (maybe@map (function (_ [type value]) + (maybe\map (function (_ [type value]) [type (#variable.Local value)])))) (def: (captured? name scope) @@ -51,7 +51,7 @@ mappings (get@ [#.captured #.mappings] scope)] (case mappings (#.Cons [_name [_source-type _source-ref]] mappings') - (if (text@= name _name) + (if (text\= name _name) (#.Some [_source-type (#variable.Foreign idx)]) (recur (inc idx) mappings')) @@ -86,7 +86,7 @@ (#.Cons top-outer _) (let [[ref-type init-ref] (maybe.default (undefined) (..reference name top-outer)) - [ref inner'] (list@fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) + [ref inner'] (list\fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) (function (_ scope ref+inner) [(#variable.Foreign (get@ [#.captured #.counter] scope)) (#.Cons (update@ #.captured @@ -97,7 +97,7 @@ (product.right ref+inner))])) [init-ref #.Nil] (list.reverse inner)) - scopes (list@compose inner' outer)] + scopes (list\compose inner' outer)] (#.Right [(set@ #.scopes scopes state) (#.Some [ref-type ref])])) ))))) @@ -202,4 +202,4 @@ (-> Scope (List Variable)) (|> scope (get@ [#.captured #.mappings]) - (list@map (function (_ [_ [_ ref]]) (ref-to-variable ref))))) + (list\map (function (_ [_ [_ ref]]) (ref-to-variable ref))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 03ce1c90b..848d0e96b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -14,7 +14,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] ["." type ["." check]] @@ -68,7 +68,7 @@ (template [<name>] [(exception: #export (<name> {key Name} {record (List [Name Code])}) (ex.report ["Tag" (%.code (code.tag key))] - ["Record" (%.code (code.record (list@map (function (_ [keyI valC]) + ["Record" (%.code (code.record (list\map (function (_ [keyI valC]) [(code.tag keyI) valC]) record)))]))] @@ -84,7 +84,7 @@ ["Actual" (%.nat actual)] ["Type" (%.type type)] ["Expression" (%.code (|> record - (list@map (function (_ [keyI valueC]) + (list\map (function (_ [keyI valueC]) [(code.tag keyI) valueC])) code.record))])) @@ -219,8 +219,8 @@ membersC) _ (//type.with-env (check.check expectedT - (type.tuple (list@map product.left membersTA))))] - (wrap (/.tuple (list@map product.right membersTA)))))) + (type.tuple (list\map product.left membersTA))))] + (wrap (/.tuple (list\map product.right membersTA)))))) (^template [<tag> <instancer>] [(<tag> _) @@ -329,7 +329,7 @@ (: (Dictionary Nat Code) (dictionary.new n.hash)) record) - #let [ordered-tuple (list@map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) + #let [ordered-tuple (list\map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) tuple-range)]] (wrap [ordered-tuple recordT])) )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux index 499ec7d37..9ec3d461c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -7,7 +7,7 @@ ["s" code]]] [data [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." meta (#+ with-gensyms)] [macro ["." code] @@ -42,7 +42,7 @@ (^ (list (~+ g!input+))) (do ///.monad [(~+ (|> g!input+ - (list@map (function (_ g!input) + (list\map (function (_ g!input) (list g!input (` ((~ g!phase) (~ g!archive) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux index c93bced64..47ad3ca78 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux @@ -17,14 +17,14 @@ ["." synthesis] [/// ["." reference] - ["#" phase ("#@." monad)]]]]]) + ["#" phase ("#\." monad)]]]]]) (def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (///@wrap (<generator> value))]) + (///\wrap (<generator> value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index d5ebb3fdc..b13e1c63f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -13,7 +13,7 @@ [data [binary (#+ Binary)] ["." product] - ["." text ("#@." hash) + ["." text ("#\." hash) ["%" format (#+ format)]] [collection ["." array] @@ -25,7 +25,7 @@ [jvm ["." loader (#+ Library)] ["_" bytecode (#+ Bytecode)] - ["." modifier (#+ Modifier) ("#@." monoid)] + ["." modifier (#+ Modifier) ("#\." monoid)] ["." field (#+ Field)] ["." method (#+ Method)] ["." version] @@ -54,10 +54,10 @@ (def: value::field "value") (def: value::type (type.class "java.lang.Object" (list))) -(def: value::modifier ($_ modifier@compose field.public field.final field.static)) +(def: value::modifier ($_ modifier\compose field.public field.final field.static)) (def: init::type (type.method [(list) type.void (list)])) -(def: init::modifier ($_ modifier@compose method.public method.static method.strict)) +(def: init::modifier ($_ modifier\compose method.public method.static method.strict)) (exception: #export (cannot-load {class Text} {error Text}) (exception.report @@ -136,7 +136,7 @@ (-> Library java/lang/ClassLoader Name (Bytecode Any) (Try [Text Any Definition])) (let [class-name (format (text.replace-all .module-separator class-path-separator module) class-path-separator (name.normalize name) - "___" (%.nat (text@hash name)))] + "___" (%.nat (text\hash name)))] (do try.monad [[value definition] (evaluate! library loader class-name valueG)] (wrap [class-name value definition])))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index f13750e56..b1861b93a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -7,7 +7,7 @@ [data ["." text] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." set]]] [target ["_" lua (#+ Expression Var Statement)]]] @@ -24,7 +24,7 @@ ["/#" // #_ ["/#" // #_ [reference (#+ Register)] - ["#." phase ("#@." monad)] + ["#." phase ("#\." monad)] [meta [archive (#+ Archive)]]]]]]]]) @@ -49,7 +49,7 @@ (Generator [Synthesis (List (Either Nat Nat))]) (do ///////phase.monad [valueO (generate archive valueS)] - (wrap (list@fold (function (_ side source) + (wrap (list\fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] [(<side> lefts) @@ -135,17 +135,17 @@ (-> Phase Archive Path (Operation Statement)) (.case pathP (^ (/////synthesis.path/then bodyS)) - (///////phase@map _.return (generate archive bodyS)) + (///////phase\map _.return (generate archive bodyS)) #/////synthesis.Pop - (///////phase@wrap ..pop!) + (///////phase\wrap ..pop!) (#/////synthesis.Bind register) - (///////phase@wrap (_.let (list (..register register)) ..peek)) + (///////phase\wrap (_.let (list (..register register)) ..peek)) (^template [<tag> <format>] [(^ (<tag> value)) - (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not) + (///////phase\wrap (_.when (|> value <format> (_.= ..peek) _.not) fail!))]) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] @@ -154,28 +154,28 @@ (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) - (///////phase@wrap (<choice> false idx)) + (///////phase\wrap (<choice> false idx)) (^ (<simple> idx nextP)) (|> nextP (pattern-matching' generate archive) - (///////phase@map (_.then (<choice> true idx))))]) + (///////phase\map (_.then (<choice> true idx))))]) ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) (^ (/////synthesis.member/left 0)) - (///////phase@wrap (|> ..peek (_.nth (_.int +1)) ..push!)) + (///////phase\wrap (|> ..peek (_.nth (_.int +1)) ..push!)) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind-top register thenP)) (do ///////phase.monad [then! (pattern-matching' generate archive thenP)] - (///////phase@wrap ($_ _.then + (///////phase\wrap ($_ _.then (_.let (list (..register register)) ..peek-and-pop) then!))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 8f9a4ce74..98c60d243 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -7,7 +7,7 @@ [data ["." product] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [target ["_" lua (#+ Expression Statement)]]] ["." // #_ @@ -49,7 +49,7 @@ [@closure (:: ! map _.var (/////generation.gensym "closure")) #let [directive (_.function @closure (|> (list.enumeration inits) - (list@map (|>> product.left ..capture))) + (list\map (|>> product.left ..capture))) ($_ _.then function-definition (_.return (_.var function-name))))] @@ -77,7 +77,7 @@ @num-args (_.var "num_args") @self (_.var function-name) initialize-self! (_.let (list (//case.register 0)) @self) - initialize! (list@fold (.function (_ post pre!) + initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! (_.let (list (..input post)) (_.nth (|> post inc .int _.int) @curried)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index f65883c4c..e04186c17 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -9,7 +9,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [target ["_" lua (#+ Expression Var)]]] ["." // #_ @@ -34,7 +34,7 @@ (generate archive bodyS)) #let [directive (_.function @loop (|> initsS+ list.enumeration - (list@map (|>> product.left (n.+ start) //case.register))) + (list\map (|>> product.left (n.+ start) //case.register))) (_.return bodyO))] _ (/////generation.execute! directive) _ (/////generation.save! (_.code @loop) directive)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index e62faf9c6..c34a998a4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -12,7 +12,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." macro ["." code] [syntax (#+ syntax:)]] @@ -96,7 +96,7 @@ (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} body) (wrap (list (` (let [(~+ (|> vars - (list@map (function (_ var) + (list\map (function (_ var) (list (code.local-identifier var) (` (_.var (~ (code.text (///reference.sanitize var)))))))) list.concat))] @@ -124,8 +124,8 @@ (let [nameC (code.local-identifier name) code-nameC (code.local-identifier (format "@" name)) runtime-nameC (` (runtime-name (~ (code.text name)))) - inputsC (list@map code.local-identifier inputs) - inputs-typesC (list@map (function.constant (` (_.Expression Any))) + inputsC (list\map code.local-identifier inputs) + inputs-typesC (list\map (function.constant (` (_.Expression Any))) inputs)] (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) (-> (~+ inputs-typesC) (Computation Any)) @@ -233,7 +233,8 @@ @tuple//right @sum//get @array//copy - @array//concat)) + @array//concat + )) (runtime: (lux//try risky) (with-vars [success value] @@ -258,7 +259,8 @@ Statement ($_ _.then @lux//try - @lux//program-args)) + @lux//program-args + )) (runtime: (i64//logic-right-shift param subject) (let [mask (|> (_.int +1) @@ -306,7 +308,8 @@ ($_ _.then @text//index @text//clip - @text//char)) + @text//char + )) (runtime: (array//new size) (with-vars [output idx] @@ -345,7 +348,9 @@ (def: runtime//box Statement - @box//write) + ($_ _.then + @box//write + )) (def: runtime Statement diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux index d06034686..0d96fe6df 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux @@ -11,13 +11,13 @@ [analysis (#+ Variant Tuple)] ["#." synthesis (#+ Synthesis)] ["//#" /// #_ - ["#." phase ("#@." monad)]]]]) + ["#." phase ("#\." monad)]]]]) (def: #export (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase@wrap (//primitive.text /////synthesis.unit)) + (///////phase\wrap (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (generate archive singletonS) @@ -25,12 +25,12 @@ _ (|> elemsS+ (monad.map ///////phase.monad (generate archive)) - (///////phase@map _.array)))) + (///////phase\map _.array)))) (def: #export (variant generate archive [lefts right? valueS]) (Generator (Variant Synthesis)) (let [tag (if right? (inc lefts) lefts)] - (///////phase@map (//runtime.variant tag right?) + (///////phase\map (//runtime.variant tag right?) (generate archive valueS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux index ad04cefdb..975301cef 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux @@ -6,7 +6,7 @@ [runtime (#+ Phase)] ["." primitive] ["." structure] - ["." reference ("#@." system)] + ["." reference ("#\." system)] ["." case] ["." loop] ["." function] @@ -34,7 +34,7 @@ (structure.tuple generate members) (#synthesis.Reference value) - (reference@reference value) + (reference\reference value) (^ (synthesis.branch/case case)) (case.case generate case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux index f2bfbd4d5..defe15b33 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -6,7 +6,7 @@ [runtime (#+ Phase)] ["#." primitive] ["#." structure] - ["#." reference ("#@." system)] + ["#." reference ("#\." system)] ["#." function] ["#." case] ["#." loop] @@ -16,14 +16,14 @@ [analysis (#+)] ["#." synthesis] ["//#" /// #_ - ["#." phase ("#@." monad)]]]]]) + ["#." phase ("#\." monad)]]]]]) (def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase@wrap (<generator> value))]) + (//////phase\wrap (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] @@ -36,7 +36,7 @@ (/structure.tuple generate archive members) (#////synthesis.Reference value) - (/reference@reference archive value) + (/reference\reference archive value) (^ (////synthesis.branch/case case)) (/case.case generate archive case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux index f2bfbd4d5..defe15b33 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux @@ -6,7 +6,7 @@ [runtime (#+ Phase)] ["#." primitive] ["#." structure] - ["#." reference ("#@." system)] + ["#." reference ("#\." system)] ["#." function] ["#." case] ["#." loop] @@ -16,14 +16,14 @@ [analysis (#+)] ["#." synthesis] ["//#" /// #_ - ["#." phase ("#@." monad)]]]]]) + ["#." phase ("#\." monad)]]]]]) (def: #export (generate archive synthesis) Phase (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase@wrap (<generator> value))]) + (//////phase\wrap (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] @@ -36,7 +36,7 @@ (/structure.tuple generate archive members) (#////synthesis.Reference value) - (/reference@reference archive value) + (/reference\reference archive value) (^ (////synthesis.branch/case case)) (/case.case generate archive case) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index 921769c00..bd85ca44a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -10,7 +10,7 @@ ["n" nat] ["i" int]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." set]]] [target ["_" ruby (#+ Expression Statement)]]] @@ -27,7 +27,7 @@ ["#." generation] ["//#" /// #_ ["#." reference (#+ Register)] - ["#." phase ("#@." monad)] + ["#." phase ("#\." monad)] [meta [archive (#+ Archive)]]]]]]]) @@ -52,7 +52,7 @@ (Generator [Synthesis (List (Either Nat Nat))]) (do ///////phase.monad [valueO (generate archive valueS)] - (wrap (list@fold (function (_ side source) + (wrap (list\fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] [(<side> lefts) @@ -139,17 +139,17 @@ (-> Phase Archive Path (Operation (Statement Any))) (.case pathP (^ (/////synthesis.path/then bodyS)) - (///////phase@map _.return (generate archive bodyS)) + (///////phase\map _.return (generate archive bodyS)) #/////synthesis.Pop - (///////phase@wrap ..pop!) + (///////phase\wrap ..pop!) (#/////synthesis.Bind register) - (///////phase@wrap (_.set (list (..register register)) ..peek)) + (///////phase\wrap (_.set (list (..register register)) ..peek)) (^template [<tag> <format>] [(^ (<tag> value)) - (///////phase@wrap (_.when (|> value <format> (_.= ..peek) _.not) + (///////phase\wrap (_.when (|> value <format> (_.= ..peek) _.not) fail!))]) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] @@ -158,28 +158,28 @@ (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) - (///////phase@wrap (<choice> false idx)) + (///////phase\wrap (<choice> false idx)) (^ (<simple> idx nextP)) (|> nextP (pattern-matching' generate archive) - (///////phase@map (_.then (<choice> true idx))))]) + (///////phase\map (_.then (<choice> true idx))))]) ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) (^ (/////synthesis.member/left 0)) - (///////phase@wrap (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!)) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind-top register thenP)) (do ///////phase.monad [then! (pattern-matching' generate archive thenP)] - (///////phase@wrap ($_ _.then + (///////phase\wrap ($_ _.then (_.set (list (..register register)) ..peek-and-pop) then!))) @@ -187,7 +187,7 @@ (.let [[extra-pops nextP'] (case.count-pops nextP)] (do ///////phase.monad [next! (pattern-matching' generate archive nextP')] - (///////phase@wrap ($_ _.then + (///////phase\wrap ($_ _.then (..multi-pop! (n.+ 2 extra-pops)) next!)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index df8fccb33..942829635 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -7,7 +7,7 @@ [data ["." product] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [target ["_" ruby (#+ Expression Statement)]]] ["." // #_ @@ -46,7 +46,7 @@ _.return (_.lambda #.None (|> (list.enumeration inits) - (list@map (|>> product.left ..capture)))) + (list\map (|>> product.left ..capture)))) (_.do "call" inits)))) (def: input @@ -70,7 +70,7 @@ @num-args (_.local "num_args") @self (_.local function-name) initialize-self! (_.set (list (//case.register 0)) @self) - initialize! (list@fold (.function (_ post pre!) + initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! (_.set (list (..input post)) (_.nth (|> post .int _.int) @curried)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index c9c68139c..42d048ed5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -9,7 +9,7 @@ [text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [target ["_" ruby (#+ Expression LVar)]]] ["." // #_ @@ -36,7 +36,7 @@ (_.lambda (#.Some @loop) (|> initsS+ list.enumeration - (list@map (|>> product.left (n.+ start) //case.register)))) + (list\map (|>> product.left (n.+ start) //case.register)))) (_.apply/* initsO+))))) (def: #export (recur generate archive argsS+) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index eda4d8a60..221442863 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -12,7 +12,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." macro ["." code] [syntax (#+ syntax:)]] @@ -94,7 +94,7 @@ (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} body) (wrap (list (` (let [(~+ (|> vars - (list@map (function (_ var) + (list\map (function (_ var) (list (code.local-identifier var) (` (_.local (~ (code.text (///reference.sanitize var)))))))) list.concat))] @@ -122,8 +122,8 @@ (let [nameC (code.local-identifier name) code-nameC (code.local-identifier (format "@" name)) runtime-nameC (` (runtime-name (~ (code.text name)))) - inputsC (list@map code.local-identifier inputs) - inputs-typesC (list@map (function.constant (` (_.Expression Any))) + inputsC (list\map code.local-identifier inputs) + inputs-typesC (list\map (function.constant (` (_.Expression Any))) inputs)] (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) (-> (~+ inputs-typesC) (Computation Any)) @@ -199,7 +199,8 @@ ($_ _.then @tuple//left @tuple//right - @sum//get)) + @sum//get + )) (runtime: (lux//try risky) (with-vars [error value] @@ -221,7 +222,8 @@ (Statement Any) ($_ _.then @lux//try - @lux//program-args)) + @lux//program-args + )) (runtime: (i64//logic-right-shift param subject) (let [mask (|> (_.int +1) @@ -233,7 +235,9 @@ (def: runtime//i64 (Statement Any) - @i64//logic-right-shift) + ($_ _.then + @i64//logic-right-shift + )) (runtime: (f64//decode inputG) (with-vars [@input @temp] @@ -250,7 +254,9 @@ (def: runtime//f64 (Statement Any) - @f64//decode) + ($_ _.then + @f64//decode + )) (runtime: (text//index subject param start) (with-vars [idx] @@ -278,7 +284,8 @@ ($_ _.then @text//index @text//clip - @text//char)) + @text//char + )) (def: runtime (Statement Any) @@ -290,7 +297,8 @@ runtime//text )) -(def: #export artifact ..prefix) +(def: #export artifact + ..prefix) (def: #export generate (Operation (Buffer (Statement Any))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux index d8eba5932..e8d192326 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux @@ -11,13 +11,13 @@ [analysis (#+ Variant Tuple)] ["#." synthesis (#+ Synthesis)] ["//#" /// #_ - ["#." phase ("#@." monad)]]]]) + ["#." phase ("#\." monad)]]]]) (def: #export (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase@wrap (//primitive.text /////synthesis.unit)) + (///////phase\wrap (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (generate archive singletonS) @@ -25,12 +25,12 @@ _ (|> elemsS+ (monad.map ///////phase.monad (generate archive)) - (///////phase@map _.array)))) + (///////phase\map _.array)))) (def: #export (variant generate archive [lefts right? valueS]) (Generator (Variant Synthesis)) (let [tag (if right? (inc lefts) lefts)] - (///////phase@map (//runtime.variant tag right?) + (///////phase\map (//runtime.variant tag right?) (generate archive valueS)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux index a6f3b3760..b25ac6bed 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux @@ -8,7 +8,7 @@ ["." number] ["." text] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [target ["_" scheme (#+ Expression Computation Var)]]] ["." // #_ @@ -16,7 +16,7 @@ ["#." primitive] ["#/" // #_ ["#." reference] - ["#/" // ("#@." monad) + ["#/" // ("#\." monad) ["#/" // #_ [reference (#+ Register)] ["#." synthesis (#+ Synthesis Path)]]]]]) @@ -38,7 +38,7 @@ (Operation Expression)) (do ////.monad [valueO (generate valueS)] - (wrap (list@fold (function (_ side source) + (wrap (list\fold (function (_ side source) (.let [method (.case side (^template [<side> <accessor>] [(<side> lefts) @@ -109,14 +109,14 @@ (generate bodyS) #/////synthesis.Pop - (////@wrap pop-cursor!) + (////\wrap pop-cursor!) (#/////synthesis.Bind register) - (////@wrap (_.define-constant (..register register) ..cursor-top)) + (////\wrap (_.define-constant (..register register) ..cursor-top)) (^template [<tag> <format> <=>] [(^ (<tag> value)) - (////@wrap (_.when (|> value <format> (<=> cursor-top) _.not/1) + (////\wrap (_.when (|> value <format> (<=> cursor-top) _.not/1) fail-pm!))]) ([/////synthesis.path/bit //primitive.bit _.eqv?/2] [/////synthesis.path/i64 (<| //primitive.i64 .int) _.=/2] @@ -125,7 +125,7 @@ (^template [<pm> <flag> <prep>] [(^ (<pm> idx)) - (////@wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))]) + (////\wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))]) (_.if (_.null?/1 @temp) fail-pm! (push-cursor! @temp))))]) @@ -134,7 +134,7 @@ (^template [<pm> <getter>] [(^ (<pm> idx)) - (////@wrap (push-cursor! (<getter> (_.int (.int idx)) cursor-top)))]) + (////\wrap (push-cursor! (<getter> (_.int (.int idx)) cursor-top)))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 448c37b02..ff740e751 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -7,21 +7,21 @@ [pipe (#+ when> new> case>)]] [data ["." product] - ["." bit ("#@." equivalence)] - ["." text ("#@." equivalence)] + ["." bit ("#\." equivalence)] + ["." text ("#\." equivalence)] [number ["." i64] ["n" nat] - ["." frac ("#@." equivalence)]] + ["." frac ("#\." equivalence)]] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." functor fold monoid)] ["." set (#+ Set)]]]] ["." /// #_ [// ["#." analysis (#+ Pattern Match Analysis)] ["/" synthesis (#+ Path Synthesis Operation Phase)] [/// - ["#" phase ("#@." monad)] + ["#" phase ("#\." monad)] ["#." reference ["#/." variable (#+ Register Variable)]] [meta @@ -40,13 +40,13 @@ thenC (#///analysis.Bit when) - (///@map (function (_ then) + (///\map (function (_ then) (#/.Bit-Fork when then #.None)) thenC) (^template [<from> <to> <conversion>] [(<from> test) - (///@map (function (_ then) + (///\map (function (_ then) (<to> [(<conversion> test) then] (list))) thenC)]) ([#///analysis.Nat #/.I64-Fork .i64] @@ -61,16 +61,16 @@ thenC) (#///analysis.Complex (#///analysis.Variant [lefts right? value-pattern])) - (<| (///@map (|>> (#/.Seq (#/.Access (#/.Side (if right? + (<| (///\map (|>> (#/.Seq (#/.Access (#/.Side (if right? (#.Right lefts) (#.Left lefts))))))) (path' value-pattern end?) - (when> [(new> (not end?) [])] [(///@map ..clean-up)]) + (when> [(new> (not end?) [])] [(///\map ..clean-up)]) thenC) (#///analysis.Complex (#///analysis.Tuple tuple)) (let [tuple::last (dec (list.size tuple))] - (list@fold (function (_ [tuple::lefts tuple::member] nextC) + (list\fold (function (_ [tuple::lefts tuple::member] nextC) (.case tuple::member (#///analysis.Simple #///analysis.Unit) nextC @@ -78,11 +78,11 @@ _ (let [right? (n.= tuple::last tuple::lefts) end?' (and end? right?)] - (<| (///@map (|>> (#/.Seq (#/.Access (#/.Member (if right? + (<| (///\map (|>> (#/.Seq (#/.Access (#/.Member (if right? (#.Right (dec tuple::lefts)) (#.Left tuple::lefts))))))) (path' tuple::member end?') - (when> [(new> (not end?') [])] [(///@map ..clean-up)]) + (when> [(new> (not end?') [])] [(///\map ..clean-up)]) nextC)))) thenC (list.reverse (list.enumeration tuple)))) @@ -90,7 +90,7 @@ (def: (path archive synthesize pattern bodyA) (-> Archive Phase Pattern Analysis (Operation Path)) - (path' pattern true (///@map (|>> #/.Then) (synthesize archive bodyA)))) + (path' pattern true (///\map (|>> #/.Then) (synthesize archive bodyA)))) (def: (weave-branch weave equivalence [new-test new-then] [[old-test old-then] old-tail]) (All [a] (-> (-> Path Path Path) (Equivalence a) [a Path] (/.Fork a Path) @@ -108,7 +108,7 @@ (def: (weave-fork weave equivalence new-fork old-fork) (All [a] (-> (-> Path Path Path) (Equivalence a) (/.Fork a Path) (/.Fork a Path) (/.Fork a Path))) - (list@fold (..weave-branch weave equivalence) old-fork (#.Cons new-fork))) + (list\fold (..weave-branch weave equivalence) old-fork (#.Cons new-fork))) (def: (weave new old) (-> Path Path Path) @@ -133,7 +133,7 @@ [(#/.Bit-Fork new-when new-then new-else) (#/.Bit-Fork old-when old-then old-else)] - (if (bit@= new-when old-when) + (if (bit\= new-when old-when) (#/.Bit-Fork old-when (weave new-then old-then) (case [new-else old-else] @@ -226,7 +226,7 @@ (do {! ///.monad} [headSP (path archive synthesize headP headA) tailSP+ (monad.map ! (product.uncurry (path archive synthesize)) tailPA+)] - (wrap (/.branch/case [input (list@fold weave headSP tailSP+)])))) + (wrap (/.branch/case [input (list\fold weave headSP tailSP+)])))) (template: (!masking <variable> <output>) [[(#///analysis.Bind <variable>) @@ -243,7 +243,7 @@ (def: #export (synthesize-masking synthesize archive input @variable @output) (-> Phase Archive Synthesis Register Register (Operation Synthesis)) (if (n.= @variable @output) - (///@wrap input) + (///\wrap input) (..synthesize-let synthesize archive input @variable (#///analysis.Reference (///reference.local @output))))) (def: #export (synthesize-if synthesize archive test then else) @@ -267,10 +267,10 @@ path (case input (^ (/.branch/get [sub-path sub-input])) - (///@wrap (/.branch/get [(list@compose path sub-path) sub-input])) + (///\wrap (/.branch/get [(list\compose path sub-path) sub-input])) _ - (///@wrap (/.branch/get [path input]))))) + (///\wrap (/.branch/get [path input]))))) (def: #export (synthesize synthesize^ [headB tailB+] archive inputA) (-> Phase Match Phase) @@ -341,7 +341,7 @@ (^or (^ (/.path/seq left right)) (^ (/.path/alt left right))) - (list@fold for-path path-storage (list left right)) + (list\fold for-path path-storage (list left right)) (^ (/.path/then bodyS)) (loop for-synthesis @@ -352,7 +352,7 @@ (for-synthesis valueS synthesis-storage) (^ (/.tuple members)) - (list@fold for-synthesis synthesis-storage members) + (list\fold for-synthesis synthesis-storage members) (#/.Reference (#///reference.Variable var)) (if (set.member? (get@ #bindings synthesis-storage) var) @@ -360,31 +360,31 @@ (update@ #dependencies (set.add var) synthesis-storage)) (^ (/.function/apply [functionS argsS])) - (list@fold for-synthesis synthesis-storage (#.Cons functionS argsS)) + (list\fold for-synthesis synthesis-storage (#.Cons functionS argsS)) (^ (/.function/abstraction [environment arity bodyS])) - (list@fold for-synthesis synthesis-storage environment) + (list\fold for-synthesis synthesis-storage environment) (^ (/.branch/let [inputS register exprS])) - (list@fold for-synthesis + (list\fold for-synthesis (update@ #bindings (set.add (#///reference/variable.Local register)) synthesis-storage) (list inputS exprS)) (^ (/.branch/if [testS thenS elseS])) - (list@fold for-synthesis synthesis-storage (list testS thenS elseS)) + (list\fold for-synthesis synthesis-storage (list testS thenS elseS)) (^ (/.branch/case [inputS pathS])) (|> synthesis-storage (for-synthesis inputS) (for-path pathS)) (^ (/.loop/scope [start initsS+ iterationS])) - (list@fold for-synthesis synthesis-storage (#.Cons iterationS initsS+)) + (list\fold for-synthesis synthesis-storage (#.Cons iterationS initsS+)) (^ (/.loop/recur replacementsS+)) - (list@fold for-synthesis synthesis-storage replacementsS+) + (list\fold for-synthesis synthesis-storage replacementsS+) (#/.Extension [extension argsS]) - (list@fold for-synthesis synthesis-storage argsS) + (list\fold for-synthesis synthesis-storage argsS) _ synthesis-storage)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 864001655..2831b2605 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -7,13 +7,13 @@ [pipe (#+ case>)] ["." exception (#+ exception:)]] [data - ["." maybe ("#@." functor)] + ["." maybe ("#\." functor)] ["." text ["%" format (#+ format)]] [number ["n" nat]] [collection - ["." list ("#@." functor monoid fold)]]]] + ["." list ("#\." functor monoid fold)]]]] ["." // #_ ["#." loop (#+ Transform)] ["//#" /// #_ @@ -23,7 +23,7 @@ [arity (#+ Arity)] ["#." reference ["#/." variable (#+ Register Variable)]] - ["." phase ("#@." monad)]]]]) + ["." phase ("#\." monad)]]]]) (exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment (Environment Synthesis)}) (exception.report @@ -34,7 +34,7 @@ (-> Arity (List Synthesis)) (|>> dec (enum.range n.enum 1) - (list@map (|>> /.variable/local)))) + (list\map (|>> /.variable/local)))) (template: #export (self-reference) (/.variable/local 0)) @@ -59,7 +59,7 @@ [locals /.locals] (wrap (|> functionS (//loop.optimization true locals argsS) - (maybe@map (: (-> [Nat (List Synthesis) Synthesis] Synthesis) + (maybe\map (: (-> [Nat (List Synthesis) Synthesis] Synthesis) (function (_ [start inits iteration]) (case iteration (^ (/.loop/scope [start' inits' output])) @@ -74,7 +74,7 @@ (wrap <apply>)) (^ (/.function/apply [funcS' argsS'])) - (wrap (/.function/apply [funcS' (list@compose argsS' argsS)])) + (wrap (/.function/apply [funcS' (list\compose argsS' argsS)])) _ (wrap <apply>))))))) @@ -83,7 +83,7 @@ (-> (Environment Synthesis) Register (Operation Synthesis)) (case (list.nth register environment) (#.Some aliased) - (phase@wrap aliased) + (phase\wrap aliased) #.None (phase.throw ..cannot-find-foreign-variable-in-environment [register environment]))) @@ -92,7 +92,7 @@ (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) (case path (#/.Bind register) - (phase@wrap (#/.Bind (inc register))) + (phase\wrap (#/.Bind (inc register))) (^template [<tag>] [(<tag> left right) @@ -130,10 +130,10 @@ (#/.Then thenS) (|> thenS grow - (phase@map (|>> #/.Then))) + (phase\map (|>> #/.Then))) _ - (phase@wrap path))) + (phase\wrap path))) (def: (grow environment expression) (-> (Environment Synthesis) Synthesis (Operation Synthesis)) @@ -143,28 +143,28 @@ (#////analysis.Variant [lefts right? subS]) (|> subS (grow environment) - (phase@map (|>> [lefts right?] /.variant))) + (phase\map (|>> [lefts right?] /.variant))) (#////analysis.Tuple membersS+) (|> membersS+ (monad.map phase.monad (grow environment)) - (phase@map (|>> /.tuple)))) + (phase\map (|>> /.tuple)))) (^ (..self-reference)) - (phase@wrap (/.function/apply [expression (list (/.variable/local 1))])) + (phase\wrap (/.function/apply [expression (list (/.variable/local 1))])) (#/.Reference reference) (case reference (#////reference.Variable variable) (case variable (#////reference/variable.Local register) - (phase@wrap (/.variable/local (inc register))) + (phase\wrap (/.variable/local (inc register))) (#////reference/variable.Foreign register) (..find-foreign environment register)) (#////reference.Constant constant) - (phase@wrap expression)) + (phase\wrap expression)) (#/.Control control) (case control @@ -205,7 +205,7 @@ (#/.Recur argumentsS+) (|> argumentsS+ (monad.map phase.monad (grow environment)) - (phase@map (|>> /.loop/recur)))) + (phase\map (|>> /.loop/recur)))) (#/.Function function) (case function @@ -227,7 +227,7 @@ (wrap (/.function/apply (case funcS (^ (/.function/apply [(..self-reference) pre-argsS+])) [(..self-reference) - (list@compose pre-argsS+ argsS+)] + (list\compose pre-argsS+ argsS+)] _ [funcS @@ -236,10 +236,10 @@ (#/.Extension name argumentsS+) (|> argumentsS+ (monad.map phase.monad (grow environment)) - (phase@map (|>> (#/.Extension name)))) + (phase\map (|>> (#/.Extension name)))) (#/.Primitive _) - (phase@wrap expression))) + (phase\wrap expression))) (def: #export (abstraction phase environment archive bodyA) (-> Phase (Environment Analysis) Phase) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index f2559460a..3c99cdef9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -3,7 +3,7 @@ [abstract ["." monad (#+ do)]] [data - ["." maybe ("#@." monad)] + ["." maybe ("#\." monad)] [number ["n" nat]] [collection @@ -66,7 +66,7 @@ (#/.Then body) (|> body body-optimization - (maybe@map (|>> #/.Then))) + (maybe\map (|>> #/.Then))) _ (#.Some path)))) @@ -91,7 +91,7 @@ (#analysis.Tuple tuple) (|> tuple (monad.map maybe.monad (recur false)) - (maybe@map (|>> /.tuple)))) + (maybe\map (|>> /.tuple)))) (#/.Reference reference) (case reference @@ -148,7 +148,7 @@ (^ (/.loop/recur args)) (|> args (monad.map maybe.monad (recur false)) - (maybe@map (|>> /.loop/recur))) + (maybe\map (|>> /.loop/recur))) (^ (/.function/abstraction [environment arity body])) (do {! maybe.monad} @@ -176,10 +176,10 @@ (#/.Extension [name args]) (|> args (monad.map maybe.monad (recur false)) - (maybe@map (|>> [name] #/.Extension)))))) + (maybe\map (|>> [name] #/.Extension)))))) (def: #export (optimization true-loop? offset inits functionS) (-> Bit Register (List Synthesis) Abstraction (Maybe [Register (List Synthesis) Synthesis])) (|> (get@ #/.body functionS) (body-optimization true-loop? offset (get@ #/.environment functionS) (get@ #/.arity functionS)) - (maybe@map (|>> [offset inits])))) + (maybe\map (|>> [offset inits])))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index c18c26246..4055f70e7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -7,14 +7,14 @@ ["." exception (#+ exception:)]] [data ["." product] - ["." maybe ("#@." functor)] + ["." maybe ("#\." functor)] [number ["n" nat]] ["." text ["%" format]] [collection ["." dictionary (#+ Dictionary)] - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." set]]]] [//// ["/" synthesis (#+ Path Synthesis)] @@ -69,12 +69,12 @@ [#/.Alt]) (#/.Bit-Fork when then else) - (#/.Bit-Fork when (recur then) (maybe@map recur else)) + (#/.Bit-Fork when (recur then) (maybe\map recur else)) (^template [<tag>] [(<tag> [[test then] tail]) (<tag> [[test (recur then)] - (list@map (function (_ [test' then']) + (list\map (function (_ [test' then']) [test' (recur then')]) tail)])]) ([#/.I64-Fork] @@ -114,7 +114,7 @@ (#analysis.Variant [lefts right (recur value)]) (#analysis.Tuple tuple) - (#analysis.Tuple (list@map recur tuple)))) + (#analysis.Tuple (list\map recur tuple)))) (#/.Reference reference) (case reference @@ -146,24 +146,24 @@ (#/.Loop (case loop (#/.Scope [start inits iteration]) (#/.Scope [(..prune redundant start) - (list@map recur inits) + (list\map recur inits) (recur iteration)]) (#/.Recur resets) - (#/.Recur (list@map recur resets)))) + (#/.Recur (list\map recur resets)))) (#/.Function function) (#/.Function (case function (#/.Abstraction [environment arity body]) - (#/.Abstraction [(list@map recur environment) + (#/.Abstraction [(list\map recur environment) arity body]) (#/.Apply abstraction inputs) - (#/.Apply (recur abstraction) (list@map recur inputs)))))) + (#/.Apply (recur abstraction) (list\map recur inputs)))))) (#/.Extension name inputs) - (#/.Extension name (list@map recur inputs))))) + (#/.Extension name (list\map recur inputs))))) (type: Redundancy (Dictionary Register Bit)) @@ -177,9 +177,9 @@ (def: (extended offset amount redundancy) (-> Register Nat Redundancy [(List Register) Redundancy]) - (let [extension (|> amount list.indices (list@map (n.+ offset)))] + (let [extension (|> amount list.indices (list\map (n.+ offset)))] [extension - (list@fold (function (_ register redundancy) + (list\fold (function (_ register redundancy) (dictionary.put register ..necessary! redundancy)) redundancy extension)])) @@ -237,7 +237,7 @@ (%.Format Redundancy) (|> redundancy dictionary.entries - (list@map (function (_ [register redundant?]) + (list\map (function (_ [register redundant?]) (%.format (%.nat register) ": " (%.bit redundant?)))) (text.join-with ", "))) @@ -307,11 +307,11 @@ (list.filter (function (_ [register redundant?]) (and (set.member? bindings register) redundant?))) - (list@map product.left))]] - (wrap [(list@fold dictionary.remove redundancy (set.to-list bindings)) + (list\map product.left))]] + (wrap [(list\fold dictionary.remove redundancy (set.to-list bindings)) (|> redundants (list.sort n.>) - (list@fold (..remove-local-from-path ..remove-local) (#/.Seq pre post)))])) + (list\fold (..remove-local-from-path ..remove-local) (#/.Seq pre post)))])) (#/.Then then) (do try.monad @@ -403,7 +403,7 @@ [[redundancy inits] (..list-optimization optimization' [redundancy inits]) #let [[extension redundancy] (..extended start (list.size inits) redundancy)] [redundancy iteration] (optimization' [redundancy iteration])] - (wrap [(list@fold dictionary.remove redundancy extension) + (wrap [(list\fold dictionary.remove redundancy extension) (#/.Control (#/.Loop (#/.Scope [start inits iteration])))])) (#/.Recur resets) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index 70e6bd8a0..ea177db2c 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -10,7 +10,7 @@ ["." io (#+ IO)] [security ["!" capability (#+ capability:)] - ["?" policy (#+ Safety Safe)]] + ["?" policy (#+ Context Safety Safe)]] [concurrency ["." stm (#+ Var STM)] ["." promise (#+ Promise) ("#@." monad)]]] @@ -21,12 +21,12 @@ ["." text ["%" format (#+ format)] ["." encoding]] - [format - ["." context (#+ Context)]] [collection ["." array (#+ Array)] ["." list ("#@." fold functor)] - ["." dictionary]]]]) + ["." dictionary]]]] + [// + [environment (#+ Environment)]]) (capability: #export (Can-Read !) (can-read [] (! (Try Text)))) @@ -40,9 +40,14 @@ (type: #export Exit Int) -(def: #export normal - Exit - +0) +(template [<code> <name>] + [(def: #export <name> + Exit + <code>)] + + [+0 normal] + [+1 error] + ) (capability: #export (Can-Wait !) (can-wait [] (! (Try Exit)))) @@ -75,9 +80,6 @@ [await ..can-wait] ))))) -(type: #export Environment - Context) - (type: #export Command Text) @@ -146,7 +148,7 @@ (def: (policy sanitize-command sanitize-argument) (Ex [?] (-> (Sanitizer Command) (Sanitizer Argument) (Policy ?))) (?.with-policy - (: (?.Context Safety Policy) + (: (Context Safety Policy) (function (_ (^open "?@.")) (structure (def: command (|>> sanitize-command (!.use ?@can-upgrade))) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 15c8c5906..719817b3b 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -5,12 +5,10 @@ [equivalence (#+ Equivalence)] ["." codec]] [control - ["e" try] - ["p" parser + ["." try] + ["<>" parser ["<.>" type] - ["</>" json] - ["l" text] - ["s" code]]] + ["</>" json]]] [data ["." bit] maybe @@ -66,7 +64,7 @@ (|> low .int int.frac #/.Number))))) (def: decode (</>.run (</>.array - (do p.monad + (do <>.monad [high </>.number low </>.number] (wrap (n.+ (|> high frac.int .nat (i64.left-shift 32)) @@ -77,7 +75,7 @@ (def: encode (|>> .nat (:: nat-codec encode))) (def: decode - (|>> (:: nat-codec decode) (:: e.functor map .int)))) + (|>> (:: nat-codec decode) (:: try.functor map .int)))) (def: (nullable writer) {#.doc "Builds a JSON generator for potentially inexistent values."} @@ -94,9 +92,9 @@ (def: encode (|>> unit.out (:: ..int-codec encode))) (def: decode - (|>> (:: ..int-codec decode) (:: e.functor map unit.in)))) + (|>> (:: ..int-codec decode) (:: try.functor map unit.in)))) -(poly: #export codec\encode +(poly: encode (with-expansions [<basic> (template [<matcher> <encoder>] [(do ! @@ -122,28 +120,28 @@ [date.Date date.codec] [day.Day day.codec] [month.Month month.codec])] - (do {! p.monad} + (do {! <>.monad} [*env* <type>.env #let [@JSON\encode (: (-> Type Code) (function (_ type) (` (-> (~ (poly.to-code *env* type)) /.JSON))))] inputT <type>.peek] - ($_ p.either + ($_ <>.either <basic> <time> (do ! - [unitT (<type>.apply (p.after (<type>.exactly unit.Qty) - <type>.any))] + [unitT (<type>.apply (<>.after (<type>.exactly unit.Qty) + <type>.any))] (wrap (` (: (~ (@JSON\encode inputT)) (:: (~! qty-codec) (~' encode)))))) (do ! [#let [g!_ (code.local-identifier "_______") g!key (code.local-identifier "_______key") g!val (code.local-identifier "_______val")] - [_ _ =val=] (<type>.apply ($_ p.and + [_ _ =val=] (<type>.apply ($_ <>.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) - codec\encode))] + encode))] (wrap (` (: (~ (@JSON\encode inputT)) (|>> ((~! d.entries)) ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) @@ -151,21 +149,21 @@ ((~! d.from-list) (~! text.hash)) #/.Object))))) (do ! - [[_ =sub=] (<type>.apply ($_ p.and + [[_ =sub=] (<type>.apply ($_ <>.and (<type>.exactly .Maybe) - codec\encode))] + encode))] (wrap (` (: (~ (@JSON\encode inputT)) ((~! ..nullable) (~ =sub=)))))) (do ! - [[_ =sub=] (<type>.apply ($_ p.and + [[_ =sub=] (<type>.apply ($_ <>.and (<type>.exactly .List) - codec\encode))] + encode))] (wrap (` (: (~ (@JSON\encode inputT)) (|>> ((~! list\map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) (do ! [#let [g!_ (code.local-identifier "_______") g!input (code.local-identifier "_______input")] - members (<type>.variant (p.many codec\encode)) + members (<type>.variant (<>.many encode)) #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON\encode inputT)) (function ((~ g!_) (~ g!input)) @@ -182,7 +180,7 @@ ((~ g!encode) (~ g!input))]))))) (list.enumeration members)))))))))) (do ! - [g!encoders (<type>.tuple (p.many codec\encode)) + [g!encoders (<type>.tuple (<>.many encode)) #let [g!_ (code.local-identifier "_______") g!members (|> (list.size g!encoders) list.indices @@ -194,7 +192,7 @@ (list.zip/2 g!members g!encoders)))])))))) ## Type recursion (do ! - [[selfC non-recC] (<type>.recursive codec\encode) + [[selfC non-recC] (<type>.recursive encode) #let [g! (code.local-identifier "____________")]] (wrap (` (: (~ (@JSON\encode inputT)) ((~! ..rec-encode) (.function ((~ g!) (~ selfC)) @@ -202,11 +200,11 @@ <type>.recursive-self ## Type applications (do ! - [partsC (<type>.apply (p.many codec\encode))] + [partsC (<type>.apply (<>.many encode))] (wrap (` ((~+ partsC))))) ## Polymorphism (do ! - [[funcC varsC bodyC] (<type>.polymorphic codec\encode)] + [[funcC varsC bodyC] (<type>.polymorphic encode)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) varsC)) @@ -217,10 +215,10 @@ <type>.parameter <type>.recursive-call ## If all else fails... - (p.fail (format "Cannot create JSON encoder for: " (type.format inputT))) + (<>.fail (format "Cannot create JSON encoder for: " (type.format inputT))) )))) -(poly: #export codec\decode +(poly: decode (with-expansions [<basic> (template [<matcher> <decoder>] [(do ! @@ -230,87 +228,87 @@ [(<type>.exactly Any) </>.null] [(<type>.sub Bit) </>.boolean] - [(<type>.sub Nat) (p.codec ..nat-codec </>.any)] - [(<type>.sub Int) (p.codec ..int-codec </>.any)] + [(<type>.sub Nat) (<>.codec ..nat-codec </>.any)] + [(<type>.sub Int) (<>.codec ..int-codec </>.any)] [(<type>.sub Frac) </>.number] [(<type>.sub Text) </>.string]) <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] (wrap (` (: (~ (@JSON\decode inputT)) - ((~! p.codec) (~! <codec>) (~! </>.string))))))] + ((~! <>.codec) (~! <codec>) (~! </>.string))))))] ## [duration.Duration duration.codec] ## [instant.Instant instant.codec] [date.Date date.codec] [day.Day day.codec] [month.Month month.codec])] - (do {! p.monad} + (do {! <>.monad} [*env* <type>.env #let [@JSON\decode (: (-> Type Code) (function (_ type) (` (</>.Parser (~ (poly.to-code *env* type))))))] inputT <type>.peek] - ($_ p.either + ($_ <>.either <basic> <time> (do ! - [unitT (<type>.apply (p.after (<type>.exactly unit.Qty) - <type>.any))] + [unitT (<type>.apply (<>.after (<type>.exactly unit.Qty) + <type>.any))] (wrap (` (: (~ (@JSON\decode inputT)) - ((~! p.codec) (~! qty-codec) (~! </>.any)))))) + ((~! <>.codec) (~! qty-codec) (~! </>.any)))))) (do ! - [[_ _ valC] (<type>.apply ($_ p.and + [[_ _ valC] (<type>.apply ($_ <>.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) - codec\decode))] + decode))] (wrap (` (: (~ (@JSON\decode inputT)) ((~! </>.dictionary) (~ valC)))))) (do ! - [[_ subC] (<type>.apply (p.and (<type>.exactly .Maybe) - codec\decode))] + [[_ subC] (<type>.apply (<>.and (<type>.exactly .Maybe) + decode))] (wrap (` (: (~ (@JSON\decode inputT)) ((~! </>.nullable) (~ subC)))))) (do ! - [[_ subC] (<type>.apply (p.and (<type>.exactly .List) - codec\decode))] + [[_ subC] (<type>.apply (<>.and (<type>.exactly .List) + decode))] (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.array) ((~! p.some) (~ subC))))))) + ((~! </>.array) ((~! <>.some) (~ subC))))))) (do ! - [members (<type>.variant (p.many codec\decode)) + [members (<type>.variant (<>.many decode)) #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON\decode inputT)) - ($_ ((~! p.or)) + ($_ ((~! <>.or)) (~+ (list\map (function (_ [tag memberC]) (if (n.= last tag) (` (|> (~ memberC) - ((~! p.after) ((~! </>.boolean!) (~ (code.bit #1)))) - ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) + ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #1)))) + ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) ((~! </>.array)))) (` (|> (~ memberC) - ((~! p.after) ((~! </>.boolean!) (~ (code.bit #0)))) - ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) + ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #0)))) + ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) ((~! </>.array)))))) (list.enumeration members)))))))) (do ! - [g!decoders (<type>.tuple (p.many codec\decode))] + [g!decoders (<type>.tuple (<>.many decode))] (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.array) ($_ ((~! p.and)) (~+ g!decoders))))))) + ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) ## Type recursion (do ! - [[selfC bodyC] (<type>.recursive codec\decode) + [[selfC bodyC] (<type>.recursive decode) #let [g! (code.local-identifier "____________")]] (wrap (` (: (~ (@JSON\decode inputT)) - ((~! p.rec) (.function ((~ g!) (~ selfC)) - (~ bodyC))))))) + ((~! <>.rec) (.function ((~ g!) (~ selfC)) + (~ bodyC))))))) <type>.recursive-self ## Type applications (do ! - [[funcC argsC] (<type>.apply (p.and codec\decode (p.many codec\decode)))] + [[funcC argsC] (<type>.apply (<>.and decode (<>.many decode)))] (wrap (` ((~ funcC) (~+ argsC))))) ## Polymorphism (do ! - [[funcC varsC bodyC] (<type>.polymorphic codec\decode)] + [[funcC varsC bodyC] (<type>.polymorphic decode)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) (</>.Parser ((~ (poly.to-code *env* inputT)) (~+ varsC))))) @@ -319,7 +317,7 @@ <type>.parameter <type>.recursive-call ## If all else fails... - (p.fail (format "Cannot create JSON decoder for: " (type.format inputT))) + (<>.fail (format "Cannot create JSON decoder for: " (type.format inputT))) )))) (syntax: #export (codec inputT) @@ -342,7 +340,7 @@ (derived: (..codec Record)))} (wrap (list (` (: (codec.Codec /.JSON (~ inputT)) (structure (def: (~' encode) - (..codec\encode (~ inputT))) + ((~! ..encode) (~ inputT))) (def: (~' decode) - ((~! </>.run) (..codec\decode (~ inputT)))) + ((~! </>.run) ((~! ..decode) (~ inputT)))) )))))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 6f98c7651..bc8f75ee0 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -43,7 +43,7 @@ ["#." cache] ["#." repository (#+ Address Repository)] ["#." dependency #_ - ["#" resolution]] + ["#" resolution (#+ Resolution)]] ["#." command (#+ Command) ["#/." clean] ["#/." pom] @@ -61,10 +61,10 @@ (list\map (|>> /repository.remote /repository.async)))) (def: (with-dependencies command profile) - (All [a] (-> (Command a) (Command a))) + (All [a] (-> (-> (file.System Promise) Resolution (Command a)) (Command a))) (do /action.monad - [_ (/command/deps.do! (file.async file.default) (..repositories profile) profile)] - (command profile))) + [resolution (/command/deps.do! (file.async file.default) (..repositories profile) profile)] + (command (file.async file.default) resolution profile))) (exception: (cannot-find-repository {repository Text} {options (Dictionary Text Address)}) diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index c29cc7b2d..84e7839f8 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -1,7 +1,7 @@ (.module: [lux (#- Name) [abstract - ["." equivalence (#+ Equivalence)] + [equivalence (#+ Equivalence)] ["." hash (#+ Hash)]] [data ["." text @@ -27,14 +27,6 @@ #name Name #version Version}) -(def: #export equivalence - (Equivalence Artifact) - ($_ equivalence.product - text.equivalence - text.equivalence - text.equivalence - )) - (def: #export hash (Hash Artifact) ($_ hash.product @@ -43,6 +35,10 @@ text.hash )) +(def: #export equivalence + (Equivalence Artifact) + (:: ..hash &equivalence)) + (template [<separator> <definition>] [(def: <definition> Text diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 0fc223376..80ff8ac8c 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -7,19 +7,21 @@ ["." try (#+ Try)] ["." io (#+ IO)] [concurrency - ["." promise]]] + ["." promise (#+ Promise)]]] [data [collection ["." array] ["." list] ["." set]]] [world - [file (#+ Path)]]] + ["." file (#+ Path)]]] ["." // #_ ["/#" // #_ ["#" profile] ["#." action (#+ Action)] - ["#." command (#+ Command)]]]) + ["#." command (#+ Command)] + [dependency + [resolution (#+ Resolution)]]]]) (import: java/nio/file/WatchKey ["#::." @@ -124,18 +126,21 @@ #.None (wrap [])))) -(def: #export (do! command profile) - (All [a] (-> (Command a) (Command Any))) +(def: #export (do! command fs resolution profile) + (All [a] + (-> (-> (file.System Promise) Resolution (Command a)) + (-> (file.System Promise) Resolution (Command Any)))) (do {! ///action.monad} - [#let [fs (java/nio/file/FileSystems::getDefault)] - watcher (promise.future (java/nio/file/FileSystem::newWatchService fs)) + [watcher (promise.future + (java/nio/file/FileSystem::newWatchService + (java/nio/file/FileSystems::getDefault))) targets (|> profile (get@ #///.sources) set.to-list (monad.map ! ..targets) (:: ! map list.concat)) _ (monad.map ! (..watch! watcher) targets) - _ (command profile)] + _ (command fs resolution profile)] (loop [_ []] (do ! [?key (..poll! watcher) @@ -143,7 +148,7 @@ (#.Some key) (do ! [_ (promise.future (..drain! watcher)) - _ (command profile)] + _ (command fs resolution profile)] (wrap [])) #.None diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index b3a096ea8..72f96b25e 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -8,7 +8,7 @@ ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise ("#@." monad)]]] + ["." promise (#+ Promise) ("#@." monad)]]] [data ["." product] ["." maybe] @@ -27,9 +27,10 @@ ["#." local] ["#." cache] ["#." repository] + ["#." shell] + ["#." runtime] ["#." dependency (#+ Dependency) ["#/." resolution (#+ Resolution)]] - ["#." shell] ["#." artifact (#+ Group Name Artifact) ["#/." type]]]) @@ -87,11 +88,11 @@ _ (exception.throw ..no-available-compiler []))) -(def: libraries - (-> Resolution (List Path)) +(def: (libraries fs) + (All [!] (-> (file.System !) Resolution (List Path))) (|>> dictionary.keys (list.filter (|>> (get@ #///dependency.type) (text@= ///artifact/type.lux-library))) - (list@map (|>> (get@ #///dependency.artifact) (///local.path file.default))))) + (list@map (|>> (get@ #///dependency.artifact) (///local.path fs))))) (import: java/lang/String) @@ -114,9 +115,8 @@ (-> Text (List Text) Text) (|> values (list@map (|>> (format name " "))) (text.join-with " "))) -(def: #export (do! profile) - (Command [Compiler - Path]) +(def: #export (do! fs resolution profile) + (-> (file.System Promise) Resolution (Command [Compiler Path])) (case [(get@ #///.program profile) (get@ #///.target profile)] [#.None _] @@ -127,26 +127,16 @@ [(#.Some program) (#.Some target)] (do ///action.monad - [cache (///cache.read-all (file.async file.default) - (set.to-list (get@ #///.dependencies profile)) - ///dependency/resolution.empty) - resolution (///dependency/resolution.all (list@map (|>> ///repository.remote ///repository.async) - (set.to-list (get@ #///.repositories profile))) - (set.to-list (get@ #///.dependencies profile)) - cache) - _ (///cache.write-all (file.async file.default) - resolution) - [resolution compiler] (promise@wrap (..compiler resolution)) + [[resolution compiler] (promise@wrap (..compiler resolution)) working-directory (promise.future ..working-directory) - #let [libraries (..libraries resolution) - [prefix output] (case compiler - (#JVM artifact) [(format "java -jar " (///local.path file.default artifact)) + #let [[prefix output] (case compiler + (#JVM artifact) [(///runtime.java (///local.path fs artifact)) "program.jar"] - (#JS artifact) [(format "node --stack_size=8192 " (///local.path file.default artifact)) + (#JS artifact) [(///runtime.node (///local.path fs artifact)) "program.js"]) - cache-directory (format working-directory (:: file.default separator) target) + cache-directory (format working-directory (:: fs separator) target) command (format prefix " build" - " " (..plural-parameter "--library" libraries) + " " (..plural-parameter "--library" (..libraries fs resolution)) " " (..plural-parameter "--source" (set.to-list (get@ #///.sources profile))) " " (..singular-parameter "--target" cache-directory) " " (..singular-parameter "--module" program))] @@ -154,5 +144,5 @@ outcome (///shell.execute command working-directory) #let [_ (log! "[BUILD ENDED]")]] (wrap [compiler - (format cache-directory (:: file.default separator) output)])) + (format cache-directory (:: fs separator) output)])) )) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index bc4d88f6c..dfe58d707 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -18,14 +18,14 @@ ["#." action (#+ Action)] ["#." cache] ["#." dependency #_ - ["#/." resolution]]]) + ["#/." resolution (#+ Resolution)]]]) (def: #export (do! fs repositories profile) - (-> (file.System Promise) (List (Repository Promise)) (Command (Set Artifact))) + (-> (file.System Promise) (List (Repository Promise)) (Command Resolution)) (do ///action.monad [#let [dependencies (set.to-list (get@ #///.dependencies profile))] cache (///cache.read-all fs dependencies ///dependency/resolution.empty) resolution (///dependency/resolution.all repositories dependencies cache) cached (///cache.write-all fs resolution) #let [_ (log! "Successfully resolved dependencies!")]] - (wrap cached))) + (wrap resolution))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index a27c07f10..d4519b2d0 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -4,25 +4,30 @@ [monad (#+ do)]] [control [concurrency - ["." promise]]] + ["." promise (#+ Promise)]]] [data [text - ["%" format (#+ format)]]]] + ["%" format (#+ format)]]] + [world + ["." file]]] ["." // #_ ["#." build] ["/#" // #_ ["#." action] ["#." command (#+ Command)] - ["#." shell]]]) + ["#." shell] + ["#." runtime] + [dependency + [resolution (#+ Resolution)]]]]) -(def: #export (do! project) - (Command Any) +(def: #export (do! fs resolution profile) + (-> (file.System Promise) Resolution (Command Any)) (do ///action.monad - [[compiler program] (//build.do! project) + [[compiler program] (//build.do! fs resolution profile) working-directory (promise.future //build.working-directory) #let [command (case compiler - (#//build.JVM artifact) (format "java -jar " program) - (#//build.JS artifact) (format "node --stack_size=8192 " program))] + (#//build.JVM artifact) (///runtime.java program) + (#//build.JS artifact) (///runtime.node program))] #let [_ (log! "[TEST STARTED]")] outcome (///shell.execute command working-directory) #let [_ (log! "[TEST ENDED]")]] diff --git a/stdlib/source/program/aedifex/runtime.lux b/stdlib/source/program/aedifex/runtime.lux new file mode 100644 index 000000000..6abfc5a62 --- /dev/null +++ b/stdlib/source/program/aedifex/runtime.lux @@ -0,0 +1,17 @@ +(.module: + [lux #* + [data + [text + ["%" format (#+ format)]]] + [world + [file (#+ Path)] + [shell (#+ Command)]]]) + +(template [<name> <command>] + [(def: #export <name> + (-> Path Command) + (|>> (format <command>)))] + + [java "java -jar "] + [node "node --stack_size=8192 "] + ) diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index 69c1cc8ab..c10f77c12 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -8,25 +8,27 @@ [security ["!" capability]] [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise)]] + [parser + ["." environment]]] [data ["." product] ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat] - ["i" int]] - [format - ["." context]]] + ["i" int]]] [math ["." random]]] {1 - ["." /]}) + ["." / + [// + [environment (#+ Environment)]]]}) (template [<name> <command> <type> <prep>] [(def: <name> - (-> <type> [/.Environment /.Command (List /.Argument)]) - (|>> <prep> list [context.empty <command>]))] + (-> <type> [Environment /.Command (List /.Argument)]) + (|>> <prep> list [environment.empty <command>]))] [echo! "echo" Text (|>)] [sleep! "sleep" Nat %.nat] @@ -73,8 +75,7 @@ (#try.Failure error) true))))) -(with-expansions [<shell-coverage> (as-is [/.Can-Execute - /.Environment /.Command /.Argument])] +(with-expansions [<shell-coverage> (as-is [/.Can-Execute /.Command /.Argument])] (def: #export (spec shell) (-> (/.Shell Promise) Test) (<| (_.with-cover [/.Shell /.Process]) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 708834481..4947dcf18 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -25,7 +25,8 @@ ["#." hash] ["#." parser] ["#." pom] - ["#." repository]]) + ["#." repository] + ["#." runtime]]) (def: test Test @@ -49,6 +50,7 @@ /parser.test /pom.test /repository.test + /runtime.test )) (program: args diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index c0617188d..ce85a2206 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -82,7 +82,7 @@ (/.do! fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) []))))] (wrap (and (and (set.member? pre dependee-artifact) (not (set.member? pre depender-artifact))) - (and (not (set.member? post dependee-artifact)) - (set.member? post depender-artifact)))))] + (and (dictionary.contains? dependee post) + (dictionary.contains? depender post)))))] (_.claim [/.do!] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index c25d6fe36..c7f6a4282 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -12,8 +12,10 @@ [data ["." binary] ["." text - ["%" format] - ["." encoding]]] + ["%" format (#+ format)] + ["." encoding]] + [collection + ["." set (#+ Set)]]] [math ["." random (#+ Random)]] [world @@ -28,6 +30,12 @@ ["#." action] ["#." format]]]}) +(def: (with-default-source sources) + (-> (Set //.Source) (Set //.Source)) + (if (set.empty? sources) + (set.add //.default-source sources) + sources)) + (def: #export test Test (<| (_.covering /._) @@ -46,6 +54,8 @@ (!.use (:: file over-write))) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] - (wrap (:: //.equivalence = expected actual)))] + (wrap (:: //.equivalence = + (update@ #//.sources ..with-default-source expected) + actual)))] (_.claim [/.read] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/runtime.lux b/stdlib/source/test/aedifex/runtime.lux new file mode 100644 index 000000000..e1c0a77c1 --- /dev/null +++ b/stdlib/source/test/aedifex/runtime.lux @@ -0,0 +1,28 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." text]] + [math + ["." random]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [path (random.ascii/alpha 5)] + (`` ($_ _.and + (~~ (template [<command>] + [(_.cover [<command>] + (let [command (<command> path)] + (and (text.starts-with? (<command> "") command) + (text.ends-with? path command))))] + + [/.java] + [/.node] + )) + ))))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 14d75527f..37ae36572 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -18,17 +18,7 @@ ["#/." memo] ["#/." mixin]] ["#." io] - ["#." parser - ["#/." analysis] - ["#/." binary] - ["#/." cli] - ["#/." code] - ["#/." json] - ["#/." synthesis] - ["#/." text] - ["#/." tree] - ["#/." type] - ["#/." xml]] + ["#." parser] ["#." pipe] ["#." reader] ["#." region] @@ -62,22 +52,6 @@ /function/mixin.test )) -(def: parser - Test - ($_ _.and - /parser.test - /parser/analysis.test - /parser/binary.test - /parser/cli.test - /parser/code.test - /parser/json.test - /parser/synthesis.test - /parser/text.test - /parser/tree.test - /parser/type.test - /parser/xml.test - )) - (def: security Test ($_ _.and @@ -94,7 +68,7 @@ /exception.test ..function /io.test - ..parser + /parser.test /pipe.test /reader.test /region.test diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index 52cd5d214..f346ff568 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -6,7 +6,7 @@ [data ["." sum] ["." name] - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat] ["i" int] @@ -111,7 +111,7 @@ <arithmetic>')) (~~ (template [<concatenative> <functional>] [(_.cover [<concatenative>] - (bit@= (<functional> parameter subject) + (bit\= (<functional> parameter subject) (||> (/.push subject) (/.push parameter) <concatenative>)))] diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 7ab561360..c25d7b07f 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -21,7 +21,7 @@ ["." / (#+ actor: message:) [// ["." atom (#+ Atom)] - ["." promise (#+ Promise Resolver) ("#@." monad)] + ["." promise (#+ Promise Resolver) ("#\." monad)] ["." frp]]]}) (exception: got-wrecked) @@ -33,11 +33,11 @@ (message state self)) ((on-stop cause state) - (promise@wrap [])) + (promise\wrap [])) (message: (count! {increment Nat} state self Nat) (let [state' (n.+ increment state)] - (promise@wrap (#try.Success [state' state'])))) + (promise\wrap (#try.Success [state' state'])))) ) (def: (mailed? outcome) @@ -53,7 +53,7 @@ #let [as-mail (: (All [a] (-> (-> a a) (/.Mail a))) (function (_ transform) (function (_ state actor) - (|> state transform #try.Success promise@wrap)))) + (|> state transform #try.Success promise\wrap)))) inc! (: (/.Mail Nat) (as-mail inc)) dec! (: (/.Mail Nat) (as-mail dec))]] (<| (_.covering /._) @@ -129,7 +129,7 @@ (let [die! (: (/.Mail Nat) (function (_ state actor) - (promise@wrap (exception.throw ..got-wrecked []))))] + (promise\wrap (exception.throw ..got-wrecked []))))] (wrap (do promise.monad [result (promise.future (do io.monad [actor (/.spawn! /.default initial-state) @@ -175,7 +175,7 @@ (message (inc state) self)) ((on-stop cause state) - (promise@wrap (exec (%.nat state) + (promise\wrap (exec (%.nat state) [])))) sent/inc? (/.mail! inc! anonymous) sent/dec? (/.mail! dec! anonymous) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index e7d418bf7..c9b19f1c7 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -16,14 +16,14 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." fold monoid)] ["." row (#+ Row)]]] [math ["." random]]] {1 ["." / [// - ["." promise ("#@." monad)] + ["." promise ("#\." monad)] ["." atom (#+ Atom atom)]]]}) (def: injection @@ -49,7 +49,7 @@ (def: #export test Test (<| (_.covering /._) - (let [(^open "list@.") (list.equivalence n.equivalence)] + (let [(^open "list\.") (list.equivalence n.equivalence)] (do random.monad [inputs (random.list 5 random.nat) sample random.nat @@ -104,14 +104,14 @@ /.from-promise /.consume)] (_.claim [/.from-promise /.consume] - (list@= (list sample) + (list\= (list sample) output)))) (wrap (do promise.monad [output (|> inputs (/.sequential 0) /.consume)] (_.claim [/.sequential] - (list@= inputs + (list\= inputs output)))) (wrap (do promise.monad [output (|> inputs @@ -119,12 +119,12 @@ (/.filter n.even?) /.consume)] (_.claim [/.filter] - (list@= (list.filter n.even? inputs) + (list\= (list.filter n.even? inputs) output)))) (wrap (do {! promise.monad} [#let [sink (: (Atom (Row Nat)) (atom.atom row.empty)) - channel (/.sequential 0 (list@compose inputs inputs))] + channel (/.sequential 0 (list\compose inputs inputs))] _ (promise.future (/.subscribe (function (_ value) (do {! io.monad} [current (atom.read sink)] @@ -141,9 +141,9 @@ promise.future (:: ! map row.to-list))] (_.claim [/.Subscriber /.subscribe] - (and (list@= inputs + (and (list\= inputs output) - (list@= output + (list\= output listened))))) (wrap (do promise.monad [actual (/.fold (function (_ input total) @@ -151,7 +151,7 @@ 0 (/.sequential 0 inputs))] (_.claim [/.fold] - (n.= (list@fold n.+ 0 inputs) + (n.= (list\fold n.+ 0 inputs) actual)))) (wrap (do promise.monad [actual (|> inputs @@ -161,7 +161,7 @@ 0) /.consume)] (_.claim [/.folds] - (list@= (list.folds n.+ 0 inputs) + (list\= (list.folds n.+ 0 inputs) actual)))) (wrap (do promise.monad [actual (|> (list distint/0 distint/0 distint/0 @@ -171,7 +171,7 @@ (/.distinct n.equivalence) /.consume)] (_.claim [/.distinct] - (list@= (list distint/0 distint/1 distint/2) + (list\= (list distint/0 distint/1 distint/2) actual)))) (let [polling-delay 10 wiggle-room (n.* 5 polling-delay) @@ -207,6 +207,6 @@ /.consume)] (_.claim [/.iterate] (and (n.= max-iterations (list.size actual)) - (list@= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) + (list\= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) actual))))) ))))) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 763ae41f8..fa81183cd 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -15,10 +15,10 @@ ["." maybe] [number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [type ["." refinement]] [math @@ -116,9 +116,9 @@ _ processB #let [outcome (io.run (atom.read resource))]] (_.claim [/.mutex /.synchronize] - (or (text@= (format expected-As expected-Bs) + (or (text\= (format expected-As expected-Bs) outcome) - (text@= (format expected-Bs expected-As) + (text\= (format expected-Bs expected-As) outcome)))))) ))) @@ -155,7 +155,7 @@ (list.repeat limit) (text.join-with "")) ids (enum.range n.enum 0 (dec limit)) - waiters (list@map (function (_ id) + waiters (list\map (function (_ id) (exec (io.run (atom.update (|>> (format "_")) resource)) (waiter resource barrier id))) ids)] diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index fd3cd53d9..ca2a0eb92 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -15,7 +15,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math ["." random]]] {1 @@ -94,7 +94,7 @@ (wrap (let [var (/.var 0)] (do {! promise.monad} [_ (|> (list.repeat iterations-per-process []) - (list@map (function (_ _) (/.commit (/.update inc var)))) + (list\map (function (_ _) (/.commit (/.update inc var)))) (monad.seq !)) cummulative (/.commit (/.read var))] (_.claim [/.STM] diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 90a2064af..a19b9e6f9 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -5,7 +5,7 @@ [monad (#+ do)]] [control ["." io (#+ IO)] - ["." state (#+ State) ("#@." monad)]] + ["." state (#+ State) ("#\." monad)]] [math ["." random]] [data @@ -14,7 +14,7 @@ ["n" nat]] [collection ["." dictionary (#+ Dictionary)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [time ["." instant] ["." duration (#+ Duration)]]] @@ -26,8 +26,8 @@ (def: (fibonacci recur input) (/.Memo Nat Nat) (case input - 0 (state@wrap 0) - 1 (state@wrap 1) + 0 (state\wrap 0) + 1 (state\wrap 1) _ (do state.monad [output-1 (recur (n.- 1 input)) output-2 (recur (n.- 2 input))] @@ -90,8 +90,8 @@ [output' (recur (dec input))] (wrap (n.* input output'))))))) expected (|> (list.indices input) - (list@map inc) - (list@fold n.* 1)) + (list\map inc) + (list\fold n.* 1)) actual (|> (memo input) (state.run (dictionary.new n.hash)) product.right)] diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index accf7659d..c4d6040cd 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -15,7 +15,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [math ["." random (#+ Random)]]] {1 @@ -39,8 +39,8 @@ (wrap (function (_ delegate recur input) output)))) expected (|> (list.indices input) - (list@map inc) - (list@fold n.* 1))]]) + (list\map inc) + (list\fold n.* 1))]]) ($_ _.and (_.with-cover [/.Mixin] ($_ _.and diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 9acf45684..569e32621 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -26,7 +26,19 @@ ["." code] [syntax (#+ syntax:)]]] {1 - ["." / (#+ Parser)]}) + ["." / (#+ Parser)]} + ["." / #_ + ["#." analysis] + ["#." binary] + ["#." cli] + ["#." code] + ["#." environment] + ["#." json] + ["#." synthesis] + ["#." text] + ["#." tree] + ["#." type] + ["#." xml]]) (def: (should-fail expected input) (All [a] (-> Text (Try a) Bit)) @@ -371,4 +383,16 @@ ..combinators-0 ..combinators-1 ..combinators-2 + + /analysis.test + /binary.test + /cli.test + /code.test + /environment.test + /json.test + /synthesis.test + /text.test + /tree.test + /type.test + /xml.test )))) diff --git a/stdlib/source/test/lux/control/parser/environment.lux b/stdlib/source/test/lux/control/parser/environment.lux new file mode 100644 index 000000000..89b174b47 --- /dev/null +++ b/stdlib/source/test/lux/control/parser/environment.lux @@ -0,0 +1,52 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["." exception]] + [data + ["." text ("#\." equivalence)] + [number + ["n" nat]] + [collection + ["." dictionary]]] + [math + ["." random]]] + {1 + ["." / + ["/#" // ("#\." monad)]]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Parser]) + ($_ _.and + (_.cover [/.empty] + (dictionary.empty? /.empty)) + (do random.monad + [expected random.nat] + (_.cover [/.run] + (|> (/.run (//\wrap expected) /.empty) + (:: try.functor map (n.= expected)) + (try.default false)))) + (do random.monad + [property (random.ascii/alpha 1) + expected (random.ascii/alpha 1)] + (_.cover [/.property] + (|> /.empty + (dictionary.put property expected) + (/.run (/.property property)) + (:: try.functor map (text\= expected)) + (try.default false)))) + (do random.monad + [property (random.ascii/alpha 1)] + (_.cover [/.unknown] + (case (/.run (/.property property) /.empty) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.unknown error)))) + ))) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index 247ae8be4..6a9809c8b 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -7,7 +7,7 @@ ["." identity] [number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]]] [math ["." random]]] @@ -33,7 +33,7 @@ (|> sample (/.let> x [(n.+ x x)])))) (_.cover [/.cond>] - (text@= (cond (n.= 0 sample) "zero" + (text\= (cond (n.= 0 sample) "zero" (n.even? sample) "even" "odd") (|> sample @@ -41,7 +41,7 @@ [n.even?] [(/.new> "even" [])] [(/.new> "odd" [])])))) (_.cover [/.if>] - (text@= (if (n.even? sample) + (text\= (if (n.even? sample) "even" "odd") (|> sample @@ -79,9 +79,9 @@ [%.nat]))] (and (n.= (inc sample) left) (n.= (dec sample) middle) - (text@= (%.nat sample) right)))) + (text\= (%.nat sample) right)))) (_.cover [/.case>] - (text@= (case (n.% 10 sample) + (text\= (case (n.% 10 sample) 0 "zero" 1 "one" 2 "two" diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 4885b52eb..13ad42f3f 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -14,7 +14,7 @@ [security ["!" capability]]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]]] [math @@ -50,20 +50,20 @@ (Ex [%] (-> Any (Policy %))) (/.with-policy (: (Context Privacy Policy) - (function (_ (^@ privilege (^open "%@."))) + (function (_ (^@ privilege (^open "%\."))) (structure (def: &hash (structure (def: &equivalence (structure (def: (= reference sample) - (text@= (!.use %@can-downgrade reference) - (!.use %@can-downgrade sample))))) + (text\= (!.use %\can-downgrade reference) + (!.use %\can-downgrade sample))))) (def: hash - (|>> (!.use %@can-downgrade) + (|>> (!.use %\can-downgrade) (:: text.hash hash))))) (def: password - (!.use %@can-upgrade)) + (!.use %\can-upgrade)) (def: privilege privilege)))))) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 246beeeab..f4eaec656 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -13,7 +13,7 @@ pipe ["." io]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]]] [math @@ -44,7 +44,7 @@ [expected random.nat alternative (|> random.nat (random.filter (|>> (n.= expected) not))) error (random.unicode 1) - #let [(^open "io@.") io.monad]]) + #let [(^open "io\.") io.monad]]) ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..try random.nat))) @@ -65,7 +65,7 @@ (_.cover [/.fail] (case (/.fail error) (#/.Failure message) - (text@= error message) + (text\= error message) _ false)) @@ -97,7 +97,7 @@ (_.cover [/.with /.lift] (let [lift (/.lift io.monad)] (|> (do (/.with io.monad) - [a (lift (io@wrap expected)) + [a (lift (io\wrap expected)) b (wrap alternative)] (wrap (n.+ a b))) io.run diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index 1bb81e06a..9ffff2f1f 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -10,7 +10,7 @@ ["n" nat]] [collection ["." set (#+ Set)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [macro ["." template]] [math @@ -32,8 +32,8 @@ languages (: (List /.Language) (`` (list (~~ (template.splice <languages>)))))] {#count count - #names (|> languages (list@map /.name) (set.from-list text.hash)) - #codes (|> languages (list@map /.code) (set.from-list text.hash)) + #names (|> languages (list\map /.name) (set.from-list text.hash)) + #codes (|> languages (list\map /.code) (set.from-list text.hash)) #languages (|> languages (set.from-list /.hash)) #test (_.cover <languages> true)}))] @@ -181,7 +181,7 @@ (Hash a) (List Bundle) [Nat (Set a)])) - (list@fold (function (_ bundle [count set]) + (list\fold (function (_ bundle [count set]) [(n.+ count (get@ #count bundle)) (set.union set (lens bundle))]) [0 (set.new hash)] @@ -191,8 +191,8 @@ Test (|> ..languages list.reverse - (list@map (get@ #test)) - (list@fold _.and + (list\map (get@ #test)) + (list\fold _.and (`` ($_ _.and (~~ (template [<lens> <tag> <hash>] [(let [[count set] (..aggregate (get@ <tag>) <hash> ..languages)] diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 43d4401ec..12fa402af 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -10,7 +10,7 @@ ["n" nat]] [collection ["." set (#+ Set)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [macro ["." template]] [math @@ -33,10 +33,10 @@ (let [count (template.count <territories>) territories (`` (list (~~ (template.splice <territories>))))] {#count count - #names (|> territories (list@map /.name) (set.from-list text.hash)) - #shorts (|> territories (list@map /.short-code) (set.from-list text.hash)) - #longs (|> territories (list@map /.long-code) (set.from-list text.hash)) - #numbers (|> territories (list@map /.numeric-code) (set.from-list n.hash)) + #names (|> territories (list\map /.name) (set.from-list text.hash)) + #shorts (|> territories (list\map /.short-code) (set.from-list text.hash)) + #longs (|> territories (list\map /.long-code) (set.from-list text.hash)) + #numbers (|> territories (list\map /.numeric-code) (set.from-list n.hash)) #territories (|> territories (set.from-list /.hash)) #test (_.cover <territories> true)}))] @@ -138,7 +138,7 @@ (Hash a) (List Bundle) [Nat (Set a)])) - (list@fold (function (_ bundle [count set]) + (list\fold (function (_ bundle [count set]) [(n.+ count (get@ #count bundle)) (set.union set (lens bundle))]) [0 (set.new hash)] @@ -148,8 +148,8 @@ Test (|> ..territories list.reverse - (list@map (get@ #test)) - (list@fold _.and + (list\map (get@ #test)) + (list\fold _.and (`` ($_ _.and (~~ (template [<lens> <tag> <hash>] [(let [[count set] (..aggregate (get@ <tag>) <hash> ..territories)] diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 673099c34..2c34e8ed5 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -5,7 +5,6 @@ ["r" math/random (#+ Random)] [abstract/monad (#+ Monad do)] [data - ["." bit ("#@." equivalence)] [number ["n" nat] ["." int] diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 4ade3f2f8..0f6b13629 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -11,7 +11,7 @@ [control ["." try]] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat]]] @@ -42,7 +42,7 @@ dummy (random.filter (|>> (n.= expected) not) random.nat) expected-error (random.ascii/upper-alpha 1) expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text@= expected-current-module) not) + dummy-module (random.filter (|>> (text\= expected-current-module) not) (random.ascii/upper-alpha 1)) expected-gensym (random.ascii/upper-alpha 1) #let [expected-lux {#.info {#.target target @@ -114,7 +114,7 @@ (: (Meta Any)) (/.run expected-lux) (!expect (^multi (#try.Failure actual-error) - (text@= expected-error actual-error))))) + (text\= expected-error actual-error))))) (_.cover [/.assert] (and (|> (/.assert expected-error true) (: (Meta Any)) @@ -123,7 +123,7 @@ (|> (/.assert expected-error false) (/.run expected-lux) (!expect (^multi (#try.Failure actual-error) - (text@= expected-error actual-error)))))) + (text\= expected-error actual-error)))))) (_.cover [/.either] (and (|> (/.either (:: /.monad wrap expected) (: (Meta Nat) @@ -143,7 +143,7 @@ (/.fail expected-error))) (/.run expected-lux) (!expect (^multi (#try.Failure actual-error) - (text@= expected-error actual-error)))) + (text\= expected-error actual-error)))) (|> (/.either (:: /.monad wrap expected) (:: /.monad wrap dummy)) (/.run expected-lux) @@ -164,7 +164,7 @@ dummy (random.filter (|>> (n.= expected) not) random.nat) expected-error (random.ascii/upper-alpha 1) expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text@= expected-current-module) not) + dummy-module (random.filter (|>> (text\= expected-current-module) not) (random.ascii/upper-alpha 1)) #let [expected-lux {#.info {#.target target #.version version @@ -187,17 +187,17 @@ (|> /.current-module-name (/.run expected-lux) (!expect (^multi (#try.Success actual-current-module) - (text@= expected-current-module actual-current-module))))) + (text\= expected-current-module actual-current-module))))) (_.cover [/.normalize] (and (|> (/.normalize ["" expected-short]) (/.run expected-lux) (!expect (^multi (#try.Success [actual-module actual-short]) - (and (text@= expected-current-module actual-module) + (and (text\= expected-current-module actual-module) (is? expected-short actual-short))))) (|> (/.normalize [dummy-module expected-short]) (/.run expected-lux) (!expect (^multi (#try.Success [actual-module actual-short]) - (and (text@= dummy-module actual-module) + (and (text\= dummy-module actual-module) (is? expected-short actual-short))))))) ))) @@ -240,7 +240,7 @@ dummy (random.filter (|>> (n.= expected) not) random.nat) expected-error (random.ascii/upper-alpha 1) expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text@= expected-current-module) not) + dummy-module (random.filter (|>> (text\= expected-current-module) not) (random.ascii/upper-alpha 1)) expected-gensym (random.ascii/upper-alpha 1) expected-location ..random-location diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux index a3c2dae7f..8acce1930 100644 --- a/stdlib/source/test/lux/meta/annotation.lux +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -19,9 +19,9 @@ ["." rev] ["." frac]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [macro - ["." code ("#@." equivalence)]]] + ["." code ("#\." equivalence)]]] {1 ["." /]} [/// @@ -127,11 +127,11 @@ [(do ! [expected (random.list 5 (random.ascii/alpha 1))] (_.cover [<definition>] - (and (|> expected (list@map code.text) code.tuple + (and (|> expected (list\map code.text) code.tuple (..annotation (name-of <tag>)) <definition> (:: (list.equivalence text.equivalence) = expected)) - (|> expected (list@map code.text) code.tuple + (|> expected (list\map code.text) code.tuple (..annotation key) <definition> (:: (list.equivalence text.equivalence) = (list))))))] @@ -155,7 +155,7 @@ (..annotation key) (/.value key) (!expect (^multi (#.Some actual) - (code@= expected actual)))))) + (code\= expected actual)))))) ..typed-value diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index 2f3e7e8ba..c866acf41 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -3,19 +3,19 @@ [abstract ["." monad (#+ do)]] [data ["%" text/format (#+ format)] - ["." name ("#@." equivalence)]] - ["r" math/random (#+ Random) ("#@." monad)] + ["." name]] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)] [control pipe] [data ["." product] ["." maybe] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." monad)] + ["." list ("#\." monad)] ["." set]]] ["." type ["." check]] @@ -44,7 +44,7 @@ #.Nil (#.Cons head+ #.Nil) - (list@map (|>> list) head+) + (list\map (|>> list) head+) (#.Cons head+ tail++) (do list.monad @@ -56,7 +56,7 @@ (-> Bit (List [Code Code]) Code (Random (List Code))) (case inputC [_ (#.Bit _)] - (r@wrap (list (' #0) (' #1))) + (r\wrap (list (' #0) (' #1))) (^template [<tag> <gen> <wrapper>] [[_ (<tag> _)] @@ -71,7 +71,7 @@ #.None (wrap (list (' _))))) - (r@wrap (list (' _))))]) + (r\wrap (list (' _))))]) ([#.Nat r.nat code.nat] [#.Int r.int code.int] [#.Rev r.rev code.rev] @@ -79,26 +79,26 @@ [#.Text (r.unicode 5) code.text]) (^ [_ (#.Tuple (list))]) - (r@wrap (list (' []))) + (r\wrap (list (' []))) [_ (#.Tuple members)] (do {! r.monad} [member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) members)] (wrap (|> member-wise-patterns exhaustive-weaving - (list@map code.tuple)))) + (list\map code.tuple)))) (^ [_ (#.Record (list))]) - (r@wrap (list (' {}))) + (r\wrap (list (' {}))) [_ (#.Record kvs)] (do {! r.monad} - [#let [ks (list@map product.left kvs) - vs (list@map product.right kvs)] + [#let [ks (list\map product.left kvs) + vs (list\map product.right kvs)] member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) vs)] (wrap (|> member-wise-patterns exhaustive-weaving - (list@map (|>> (list.zip/2 ks) code.record))))) + (list\map (|>> (list.zip/2 ks) code.record))))) (^ [_ (#.Form (list [_ (#.Tag _)] _))]) (do {! r.monad} @@ -106,13 +106,13 @@ (function (_ [_tag _code]) (do ! [v-branches (exhaustive-branches allow-literals? variantTC _code)] - (wrap (list@map (function (_ pattern) (` ((~ _tag) (~ pattern)))) + (wrap (list\map (function (_ pattern) (` ((~ _tag) (~ pattern)))) v-branches)))) variantTC)] - (wrap (list@join bundles))) + (wrap (list\join bundles))) _ - (r@wrap (list)) + (r\wrap (list)) )) (def: #export (input variant-tags record-tags primitivesC) @@ -120,7 +120,7 @@ (r.rec (function (_ input) ($_ r.either - (r@map product.right _primitive.primitive) + (r\map product.right _primitive.primitive) (do {! r.monad} [choice (|> r.nat (:: ! map (n.% (list.size variant-tags)))) #let [choiceT (maybe.assume (list.nth choice variant-tags)) @@ -130,7 +130,7 @@ [size (|> r.nat (:: ! map (n.% 3))) elems (r.list size input)] (wrap (code.tuple elems))) - (r@wrap (code.record (list.zip/2 record-tags primitivesC))) + (r\wrap (code.record (list.zip/2 record-tags primitivesC))) )))) (def: (branch body pattern) @@ -142,16 +142,16 @@ (do {! r.monad} [module-name (r.unicode 5) variant-name (r.unicode 5) - record-name (|> (r.unicode 5) (r.filter (|>> (text@= variant-name) not))) + record-name (|> (r.unicode 5) (r.filter (|>> (text\= variant-name) not))) size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) record-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) primitivesTC (r.list size _primitive.primitive) - #let [primitivesT (list@map product.left primitivesTC) - primitivesC (list@map product.right primitivesTC) + #let [primitivesT (list\map product.left primitivesTC) + primitivesC (list\map product.right primitivesTC) code-tag (|>> [module-name] code.tag) - variant-tags+ (list@map code-tag variant-tags) - record-tags+ (list@map code-tag record-tags) + variant-tags+ (list\map code-tag variant-tags) + record-tags+ (list\map code-tag record-tags) variantTC (list.zip/2 variant-tags+ primitivesC)] inputC (input variant-tags+ record-tags+ primitivesC) [outputT outputC] (r.filter (|>> product.left (is? Any) not) @@ -169,7 +169,7 @@ (type.tuple primitivesT)))]) (//module.with-module 0 module-name)))] exhaustive-patterns (exhaustive-branches true variantTC inputC) - #let [exhaustive-branchesC (list@map (branch outputC) + #let [exhaustive-branchesC (list\map (branch outputC) exhaustive-patterns)]] ($_ _.and (_.test "Will reject empty pattern-matching (no branches)." diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index 4fa365850..67c02f142 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -4,8 +4,8 @@ ["." monad (#+ do)]] [data ["%" text/format (#+ format)] - ["." name ("#@." equivalence)]] - ["r" math/random (#+ Random) ("#@." monad)] + ["." name]] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe @@ -13,11 +13,11 @@ [data ["." maybe] ["." product] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." type] ["." macro ["." code]]] @@ -53,7 +53,7 @@ (def: abstraction (do r.monad [func-name (r.unicode 5) - arg-name (|> (r.unicode 5) (r.filter (|>> (text@= func-name) not))) + arg-name (|> (r.unicode 5) (r.filter (|>> (text\= func-name) not))) [outputT outputC] _primitive.primitive [inputT _] _primitive.primitive #let [g!arg (code.local-identifier arg-name)]] @@ -85,8 +85,8 @@ partial-args (|> r.nat (:: ! map (n.% full-args))) var-idx (|> r.nat (:: ! map (|>> (n.% full-args) (n.max 1)))) inputsTC (r.list full-args _primitive.primitive) - #let [inputsT (list@map product.left inputsTC) - inputsC (list@map product.right inputsTC)] + #let [inputsT (list\map product.left inputsTC) + inputsC (list\map product.right inputsTC)] [outputT outputC] _primitive.primitive #let [funcT (type.function inputsT outputT) partialT (type.function (list.drop partial-args inputsT) outputT) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index d2864e6a1..c26e16a6f 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -6,13 +6,12 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)] [control pipe ["." try (#+ Try)] ["." exception (#+ exception:)]] - ["." type ("#@." equivalence)] [macro ["." code]]] {1 @@ -55,9 +54,9 @@ (Random [Type Code]) (`` ($_ r.either (~~ (template [<type> <code-wrapper> <value-gen>] - [(r.and (r@wrap <type>) (r@map <code-wrapper> <value-gen>))] + [(r.and (r\wrap <type>) (r\map <code-wrapper> <value-gen>))] - [Any code.tuple (r.list 0 (r@wrap (' [])))] + [Any code.tuple (r.list 0 (r\wrap (' [])))] [Bit code.bit r.bit] [Nat code.nat r.nat] [Int code.int r.int] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index b67193533..ec5ef8ae0 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -2,17 +2,17 @@ [lux #* [abstract ["." monad (#+ do)]] [data - ["." name ("#@." equivalence)]] - ["r" math/random (#+ Random) ("#@." monad)] + ["." name ("#\." equivalence)]] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe ["." try (#+ Try)]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]]] - ["." type ("#@." equivalence)] + ["." type ("#\." equivalence)] [macro ["." code]]] [// @@ -70,7 +70,7 @@ scope-name (r.unicode 5) var-name (r.unicode 5) dependent-module (|> (r.unicode 5) - (r.filter (|>> (text@= def-module) not)))] + (r.filter (|>> (text\= def-module) not)))] ($_ _.and (_.test "Can analyse variable." (|> (//scope.with-scope scope-name @@ -79,7 +79,7 @@ (_primitive.phase archive.empty (code.local-identifier var-name))))) (phase.run _primitive.state) (case> (^ (#try.Success [inferredT (#////analysis.Reference (////reference.local var))])) - (and (type@= expectedT inferredT) + (and (type\= expectedT inferredT) (n.= 0 var)) _ @@ -93,8 +93,8 @@ (//module.with-module 0 def-module) (phase.run _primitive.state) (case> (^ (#try.Success [_ inferredT (#////analysis.Reference (////reference.constant constant-name))])) - (and (type@= expectedT inferredT) - (name@= def-name constant-name)) + (and (type\= expectedT inferredT) + (name\= def-name constant-name)) _ false)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux index fc6d49b3d..5ef40f052 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -4,20 +4,20 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe ["." try]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["." product] ["." maybe] ["." text] [number ["n" nat]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." set]]] ["." type ["." check]] @@ -62,7 +62,7 @@ actual//lefts (get@ #////analysis.lefts variant)] (and (n.= expected//lefts actual//lefts) - (bit@= expected//right? + (bit\= expected//right? actual//right?)))) (def: (check-sum type tag size analysis) @@ -123,14 +123,14 @@ primitives (r.list size _primitive.primitive) +choice (|> r.nat (:: ! map (n.% (inc size)))) [_ +valueC] _primitive.primitive - #let [variantT (type.variant (list@map product.left primitives)) + #let [variantT (type.variant (list\map product.left primitives)) [valueT valueC] (maybe.assume (list.nth choice primitives)) +size (inc size) +primitives (list.concat (list (list.take choice primitives) (list [(#.Parameter 1) +valueC]) (list.drop choice primitives))) [+valueT +valueC] (maybe.assume (list.nth +choice +primitives)) - +variantT (type.variant (list@map product.left +primitives))]] + +variantT (type.variant (list\map product.left +primitives))]] (<| (_.context (%.name (name-of /.sum))) ($_ _.and (_.test "Can analyse." @@ -174,17 +174,17 @@ primitives (r.list size _primitive.primitive) choice (|> r.nat (:: ! map (n.% size))) [_ +valueC] _primitive.primitive - #let [tupleT (type.tuple (list@map product.left primitives)) + #let [tupleT (type.tuple (list\map product.left primitives)) [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume) +primitives (list.concat (list (list.take choice primitives) (list [(#.Parameter 1) +valueC]) (list.drop choice primitives))) - +tupleT (type.tuple (list@map product.left +primitives))]] + +tupleT (type.tuple (list\map product.left +primitives))]] (<| (_.context (%.name (name-of /.product))) ($_ _.and (_.test "Can analyse." (|> (//type.with-type tupleT - (/.product archive.empty _primitive.phase (list@map product.right primitives))) + (/.product archive.empty _primitive.phase (list\map product.right primitives))) (phase.run _primitive.state) (case> (#try.Success tupleA) (correct-size? size tupleA) @@ -193,7 +193,7 @@ false))) (_.test "Can infer." (|> (//type.with-inference - (/.product archive.empty _primitive.phase (list@map product.right primitives))) + (/.product archive.empty _primitive.phase (list\map product.right primitives))) (phase.run _primitive.state) (case> (#try.Success [_type tupleA]) (and (check.checks? tupleT _type) @@ -209,9 +209,9 @@ (|> (do phase.monad [[_ varT] (//type.with-env check.var) _ (//type.with-env - (check.check varT (type.tuple (list@map product.left primitives))))] + (check.check varT (type.tuple (list\map product.left primitives))))] (//type.with-type varT - (/.product archive.empty _primitive.phase (list@map product.right primitives)))) + (/.product archive.empty _primitive.phase (list\map product.right primitives)))) (phase.run _primitive.state) (case> (#try.Success tupleA) (correct-size? size tupleA) @@ -220,11 +220,11 @@ false))) (_.test "Can analyse through existential quantification." (|> (//type.with-type (type.ex-q 1 +tupleT) - (/.product archive.empty _primitive.phase (list@map product.right +primitives))) + (/.product archive.empty _primitive.phase (list\map product.right +primitives))) check-succeeds)) (_.test "Cannot analyse through universal quantification." (|> (//type.with-type (type.univ-q 1 +tupleT) - (/.product archive.empty _primitive.phase (list@map product.right +primitives))) + (/.product archive.empty _primitive.phase (list\map product.right +primitives))) check-fails)) )))) @@ -239,7 +239,7 @@ type-name (r.unicode 5) #let [with-name (|>> (#.Named [module-name type-name])) varT (#.Parameter 1) - primitivesT (list@map product.left primitives) + primitivesT (list\map product.left primitives) [choiceT choiceC] (maybe.assume (list.nth choice primitives)) [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives)) monoT (type.variant primitivesT) @@ -283,9 +283,9 @@ type-name (r.unicode 5) choice (|> r.nat (:: ! map (n.% size))) #let [varT (#.Parameter 1) - tagsC (list@map (|>> [module-name] code.tag) tags) - primitivesT (list@map product.left primitives) - primitivesC (list@map product.right primitives) + tagsC (list\map (|>> [module-name] code.tag) tags) + primitivesT (list\map product.left primitives) + primitivesC (list\map product.right primitives) monoT (#.Named [module-name type-name] (type.tuple primitivesT)) recordC (list.zip/2 tagsC primitivesC) polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 0c0a2d467..b479b523a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -5,7 +5,7 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe @@ -15,7 +15,7 @@ ["." atom]]] [data ["." product]] - ["." type ("#@." equivalence)] + ["." type ("#\." equivalence)] [macro ["." code]]] [//// @@ -58,7 +58,7 @@ (do r.monad [[primT primC] ..primitive [antiT antiC] (|> ..primitive - (r.filter (|>> product.left (type@= primT) not)))] + (r.filter (|>> product.left (type\= primT) not)))] ($_ _.and (_.test "Can test for reference equality." (check-success+ "lux is" (list primC primC) Bit)) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 0a59b5534..16ef89258 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -6,7 +6,7 @@ ["." monad (#+ do)]] [control [pipe (#+ case>)] - ["." try ("#@." functor)]] + ["." try ("#\." functor)]] [data ["." sum] ["." text @@ -17,10 +17,10 @@ ["." rev] ["." frac]] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." functor fold monoid)] ["." set]]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random)]]] ["." // #_ ["#." primitive]] {1 @@ -53,7 +53,7 @@ (|> maskA (//.phase archive.empty) (phase.run [///bundle.empty synthesis.init]) - (try@map (//primitive.corresponds? maskedA)) + (try\map (//primitive.corresponds? maskedA)) (try.default false))))) (def: let-test @@ -127,16 +127,16 @@ (Random [analysis.Pattern Register])) (do random.monad [@member random.nat] - (wrap [(list@fold (function (_ member inner) + (wrap [(list\fold (function (_ member inner) (case member (#.Left lefts) (analysis.pattern/tuple - (list@compose (list.repeat lefts (analysis.pattern/unit)) + (list\compose (list.repeat lefts (analysis.pattern/unit)) (list inner (analysis.pattern/unit)))) (#.Right lefts) (analysis.pattern/tuple - (list@compose (list.repeat (inc lefts) (analysis.pattern/unit)) + (list\compose (list.repeat (inc lefts) (analysis.pattern/unit)) (list inner))))) (#analysis.Bind @member) (list.reverse path)) @@ -290,26 +290,26 @@ branch (: (-> Nat Bit Text Frac Branch) (function (_ lefts right? value body) {#analysis.when (if right? - (analysis.pattern/tuple (list@compose (list.repeat (inc lefts) (analysis.pattern/unit)) + (analysis.pattern/tuple (list\compose (list.repeat (inc lefts) (analysis.pattern/unit)) (list (analysis.pattern/text value)))) - (analysis.pattern/tuple ($_ list@compose + (analysis.pattern/tuple ($_ list\compose (list.repeat lefts (analysis.pattern/unit)) (list (analysis.pattern/text value) (analysis.pattern/unit))))) #analysis.then (analysis.frac body)}))]] - (wrap [(list@fold (function (_ left right) + (wrap [(list\fold (function (_ left right) (#synthesis.Alt left right)) (path (inc mid-size) true value/last body/last) (|> (list.zip/2 value/mid body/mid) (#.Cons [value/first body/first]) list.enumeration - (list@map (function (_ [lefts' [value body]]) + (list\map (function (_ [lefts' [value body]]) (path lefts' false value body))) list.reverse)) [(branch 0 false value/first body/first) - (list@compose (|> (list.zip/2 value/mid body/mid) + (list\compose (|> (list.zip/2 value/mid body/mid) list.enumeration - (list@map (function (_ [lefts' [value body]]) + (list\map (function (_ [lefts' [value body]]) (branch (inc lefts') false value body)))) (list (branch (inc mid-size) true value/last body/last)))]]))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 4d92094d3..ffb04e31b 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -13,7 +13,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." functor fold monoid)] ["." dictionary (#+ Dictionary)] ["." set]]] [math @@ -32,7 +32,7 @@ [/// [arity (#+ Arity)] ["." reference - ["." variable (#+ Variable) ("#@." equivalence)]] + ["." variable (#+ Variable)]] ["." phase] [meta ["." archive]]]]]]]}) @@ -51,11 +51,11 @@ (def: (n-abstraction arity body) (-> Arity Analysis Analysis) - (list@fold (function (_ arity-1 body) + (list\fold (function (_ arity-1 body) (case arity-1 0 (#analysis.Function (list) body) - _ (#analysis.Function ($_ list@compose - (list@map (|>> #variable.Foreign) + _ (#analysis.Function ($_ list\compose + (list\map (|>> #variable.Foreign) (list.indices arity-1)) (list (#variable.Local 1))) body))) @@ -230,7 +230,7 @@ #analysis.value (#analysis.Bind 2)}) #analysis.then actual-output} {#analysis.when (analysis.pattern/tuple - (list@compose (list.repeat lefts (analysis.pattern/unit)) + (list\compose (list.repeat lefts (analysis.pattern/unit)) (if right? (list (analysis.pattern/unit) (#analysis.Bind 2)) (list (#analysis.Bind 2) (analysis.pattern/unit))))) @@ -289,7 +289,7 @@ expected-record]) (#analysis.Case actual-record [{#analysis.when (analysis.pattern/tuple - (list@compose (list.repeat lefts (analysis.pattern/unit)) + (list\compose (list.repeat lefts (analysis.pattern/unit)) (if right? (list (analysis.pattern/unit) (#analysis.Bind 2)) (list (#analysis.Bind 2) (analysis.pattern/unit))))) @@ -308,27 +308,27 @@ (do {! random.monad} [resets (random.list arity (random-value false))] (wrap [true - (synthesis.loop/recur (list@map (|>> product.right product.left) resets)) + (synthesis.loop/recur (list\map (|>> product.right product.left) resets)) (analysis.apply [(#analysis.Reference (case arity 1 (reference.local 0) _ (reference.foreign 0))) - (list@map (|>> product.right product.right) resets)])]))) + (list\map (|>> product.right product.right) resets)])]))) (def: (random-scope arity output?) (-> Arity Scenario) (do {! random.monad} [resets (random.list arity (..random-variable arity output?)) [_ expected-output actual-output] (..random-nat output?)] - (wrap [(list@fold (function (_ new old) + (wrap [(list\fold (function (_ new old) (and new old)) true - (list@map product.left resets)) + (list\map product.left resets)) (synthesis.loop/scope {#synthesis.start (inc arity) - #synthesis.inits (list@map (|>> product.right product.left) resets) + #synthesis.inits (list\map (|>> product.right product.left) resets) #synthesis.iteration expected-output}) (analysis.apply [(..n-abstraction arity actual-output) - (list@map (|>> product.right product.right) resets)])]))) + (list\map (|>> product.right product.right) resets)])]))) (def: (random-loop arity random-value output?) (-> Arity Scenario Scenario) @@ -344,8 +344,8 @@ (do {! random.monad} [[loop?-output expected-output actual-output] (..random-nat output?) arity (|> random.nat (:: ! map (|>> (n.% 5) inc))) - #let [environment ($_ list@compose - (list@map (|>> #variable.Foreign) + #let [environment ($_ list\compose + (list\map (|>> #variable.Foreign) (list.indices arity)) (list (#variable.Local 1)))]] (wrap [true @@ -365,14 +365,14 @@ [[loop?-abstraction expected-abstraction actual-abstraction] (..random-nat output?) arity (|> random.nat (:: ! map (|>> (n.% 5) inc))) inputs (random.list arity (random-value false))] - (wrap [(list@fold (function (_ new old) + (wrap [(list\fold (function (_ new old) (and new old)) loop?-abstraction - (list@map product.left inputs)) + (list\map product.left inputs)) (synthesis.function/apply [expected-abstraction - (list@map (|>> product.right product.left) inputs)]) + (list\map (|>> product.right product.left) inputs)]) (analysis.apply [actual-abstraction - (list@map (|>> product.right product.right) inputs)])]))) + (list\map (|>> product.right product.right) inputs)])]))) (def: (random-function random-value output?) (-> Scenario Scenario) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 2667eedac..05a6095bb 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -10,9 +10,9 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {1 ["." / [//// @@ -112,7 +112,7 @@ (let [pattern (: (Scenario Path) (.function (recur offset arity next) (`` ($_ random.either - (random@wrap [next + (random\wrap [next [//.path/pop //.path/pop]]) (~~ (template [<path> <random>] @@ -139,7 +139,7 @@ [//.path/side] [//.path/member] )) - (random@wrap [(inc next) + (random\wrap [(inc next) [(//.path/bind (/.register-optimization offset next)) (//.path/bind next)]]) )))) @@ -276,7 +276,7 @@ (case (/.optimization true expected-offset expected-inits {#//.environment (|> expected-offset list.indices - (list@map (|>> #variable.Local))) + (list\map (|>> #variable.Local))) #//.arity arity #//.body iteration}) (^ (#.Some (//.loop/scope [actual-offset actual-inits diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index 1a215fb3b..69f087de7 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -11,7 +11,7 @@ ["n" nat]] [collection ["." list]]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)]] {1 ["." / #_ @@ -87,10 +87,10 @@ _ false))))] - [#////analysis.Unit #////synthesis.Text (r@wrap ////synthesis.unit)] + [#////analysis.Unit #////synthesis.Text (r\wrap ////synthesis.unit)] [#////analysis.Bit #////synthesis.Bit r.bit] - [#////analysis.Nat #////synthesis.I64 (r@map .i64 r.nat)] - [#////analysis.Int #////synthesis.I64 (r@map .i64 r.int)] - [#////analysis.Rev #////synthesis.I64 (r@map .i64 r.rev)] + [#////analysis.Nat #////synthesis.I64 (r\map .i64 r.nat)] + [#////analysis.Int #////synthesis.I64 (r\map .i64 r.int)] + [#////analysis.Rev #////synthesis.I64 (r\map .i64 r.rev)] [#////analysis.Frac #////synthesis.F64 r.frac] [#////analysis.Text #////synthesis.Text (r.unicode 5)])))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux index d759ff213..b51a196f0 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux @@ -4,13 +4,13 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe ["." try]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["." product] [number ["n" nat]] @@ -49,7 +49,7 @@ (case> (^ (#try.Success (////synthesis.variant [leftsS right?S valueS]))) (let [tagS (if right?S (inc leftsS) leftsS)] (and (n.= tagA tagS) - (|> tagS (n.= (dec size)) (bit@= right?S)) + (|> tagS (n.= (dec size)) (bit\= right?S)) (//primitive.corresponds? memberA valueS))) _ diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 45706256b..437d721cd 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -15,7 +15,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)]]]] {1 ["." / @@ -97,8 +97,8 @@ (Scenario Synthesis) (let [registers (dictionary.entries (get@ #necessary context))] (:: random.monad wrap - [(synthesis.tuple (list@map (|>> product.left synthesis.variable/local) registers)) - (synthesis.tuple (list@map (|>> product.right synthesis.variable/local) registers))]))) + [(synthesis.tuple (list\map (|>> product.left synthesis.variable/local) registers)) + (synthesis.tuple (list\map (|>> product.right synthesis.variable/local) registers))]))) (def: (structure-scenario context) (Scenario Synthesis) @@ -244,23 +244,23 @@ inits (random.list ..scope-arity (scenario context)) [expected-iteration actual-iteration] (scenario (update@ #necessary (function (_ necessary) - (list@fold (function (_ [idx _] context) + (list\fold (function (_ [idx _] context) (dictionary.put (n.+ real-start idx) (n.+ fake-start idx) context)) necessary (list.enumeration inits))) context))] - (wrap [(synthesis.loop/scope [real-start (list@map product.left inits) expected-iteration]) - (synthesis.loop/scope [fake-start (list@map product.right inits) actual-iteration])]))) + (wrap [(synthesis.loop/scope [real-start (list\map product.left inits) expected-iteration]) + (synthesis.loop/scope [fake-start (list\map product.right inits) actual-iteration])]))) (def: (recur-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do {! random.monad} [_ (wrap []) resets (random.list ..scope-arity (scenario context))] - (wrap [(synthesis.loop/recur (list@map product.left resets)) - (synthesis.loop/recur (list@map product.right resets))]))) + (wrap [(synthesis.loop/recur (list\map product.left resets)) + (synthesis.loop/recur (list\map product.right resets))]))) (def: (loop-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -274,8 +274,8 @@ (do {! random.monad} [_ (wrap []) #let [registers (dictionary.entries (get@ #necessary context)) - expected-environment (list@map (|>> product.left #variable.Local) registers) - actual-environment (list@map (|>> product.right #variable.Local) registers)] + expected-environment (list\map (|>> product.left #variable.Local) registers) + actual-environment (list\map (|>> product.right #variable.Local) registers)] [expected-body actual-body] (..primitive-scenario context)] (wrap [(synthesis.function/abstraction [expected-environment 1 expected-body]) (synthesis.function/abstraction [actual-environment 1 actual-body])]))) @@ -287,8 +287,8 @@ (random.and (random.unicode 1) (random.unicode 1))) inputs (random.list ..scope-arity (scenario context))] - (wrap [(synthesis.function/apply [abstraction (list@map product.left inputs)]) - (synthesis.function/apply [abstraction (list@map product.right inputs)])]))) + (wrap [(synthesis.function/apply [abstraction (list\map product.left inputs)]) + (synthesis.function/apply [abstraction (list\map product.right inputs)])]))) (def: (function-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index 7c2ece82e..c93eae5f9 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -6,7 +6,7 @@ ["." name] [number ["n" nat]]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)] [control ["." try] @@ -38,18 +38,18 @@ (Random Code) (let [numeric^ (: (Random Code) ($_ r.either - (|> r.bit (r@map code.bit)) - (|> r.nat (r@map code.nat)) - (|> r.int (r@map code.int)) - (|> r.rev (r@map code.rev)) - (|> r.safe-frac (r@map code.frac)))) + (|> r.bit (r\map code.bit)) + (|> r.nat (r\map code.nat)) + (|> r.int (r\map code.int)) + (|> r.rev (r\map code.rev)) + (|> r.safe-frac (r\map code.frac)))) textual^ (: (Random Code) ($_ r.either (do r.monad - [size (|> r.nat (r@map (n.% 20)))] - (|> (r.ascii/upper-alpha size) (r@map code.text))) - (|> name^ (r@map code.identifier)) - (|> name^ (r@map code.tag)))) + [size (|> r.nat (r\map (n.% 20)))] + (|> (r.ascii/upper-alpha size) (r\map code.text))) + (|> name^ (r\map code.identifier)) + (|> name^ (r\map code.tag)))) simple^ (: (Random Code) ($_ r.either numeric^ @@ -57,16 +57,16 @@ (r.rec (function (_ code^) (let [multi^ (do r.monad - [size (|> r.nat (r@map (n.% 3)))] + [size (|> r.nat (r\map (n.% 3)))] (r.list size code^)) composite^ (: (Random Code) ($_ r.either - (|> multi^ (r@map code.form)) - (|> multi^ (r@map code.tuple)) + (|> multi^ (r\map code.form)) + (|> multi^ (r\map code.tuple)) (do r.monad - [size (|> r.nat (r@map (n.% 3)))] + [size (|> r.nat (r\map (n.% 3)))] (|> (r.list size (r.and code^ code^)) - (r@map code.record)))))] + (r\map code.record)))))] ($_ r.either simple^ composite^)))))) @@ -110,7 +110,7 @@ (Random Text) (let [char-gen (|> r.nat (r.filter (|>> (n.= (`` (char (~~ (static text.new-line))))) not)))] (do r.monad - [size (|> r.nat (r@map (n.% 20)))] + [size (|> r.nat (r\map (n.% 20)))] (r.text char-gen size)))) (def: comment^ diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index f98fc6a17..094b32420 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -5,22 +5,39 @@ [monad (#+ do)]] [control ["." try (#+ Try)] - ["." exception (#+ exception:)]] + ["." exception (#+ exception:)] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]] + [parser + ["." environment]]] [data + ["." text ("#\." equivalence)] [number ["n" nat] ["i" int]] [collection - ["." list]]]] + ["." list]]] + [math + ["." random]]] {1 - ["." /]} + ["." / + [// + [environment (#+ Environment)]]]} {[1 #spec] ["$." /]}) +(macro: (|private| definition+ compiler) + (let [[module _] (name-of /._)] + (#.Right [compiler (list (` ("lux in-module" (~ [["" 0 0] (#.Text module)]) + (~+ definition+))))]))) + (exception: dead) (def: (simulation [environment command arguments]) - (-> [/.Environment /.Command (List /.Argument)] + (-> [Environment /.Command (List /.Argument)] (/.Simulation Bit)) (structure (def: (on-read dead?) @@ -50,9 +67,80 @@ (exception.throw ..dead []) (#try.Success [true /.normal]))))) +(def: (io-shell command oops input destruction exit) + (-> /.Command Text Text Text /.Exit (/.Shell IO)) + (structure + (def: execute + ((|private| /.can-execute) + (function (_ [environment command arguments]) + (io.io + (#try.Success + (: (/.Process IO) + (structure + (def: read + ((|private| /.can-read) + (function (_ _) + (io.io (#try.Success command))))) + (def: error + ((|private| /.can-read) + (function (_ _) + (io.io (#try.Success oops))))) + (def: write + ((|private| /.can-write) + (function (_ message) + (io.io (#try.Failure message))))) + (def: destroy + ((|private| /.can-destroy) + (function (_ _) + (io.io (#try.Failure destruction))))) + (def: await + ((|private| /.can-wait) + (function (_ _) + (io.io (#try.Success exit)))))))))))))) + (def: #export test Test (<| (_.covering /._) - (_.with-cover [/.mock /.Simulation] - ($/.spec (/.mock (|>> ..simulation #try.Success) - false))))) + ($_ _.and + (_.with-cover [/.mock /.Simulation] + ($/.spec (/.mock (|>> ..simulation #try.Success) + false))) + (_.cover [/.error] + (not (i.= /.normal /.error))) + (do random.monad + [command (random.ascii/alpha 5) + oops (random.ascii/alpha 5) + input (random.ascii/alpha 5) + destruction (random.ascii/alpha 5) + exit random.int + #let [shell (/.async (..io-shell command oops input destruction exit))]] + (wrap (do {! promise.monad} + [verdict (do (try.with !) + [process (!.use (:: shell execute) [environment.empty command (list)]) + read (!.use (:: process read) []) + error (!.use (:: process error) []) + write? (do ! + [write (!.use (:: process write) [input])] + (wrap (#try.Success (case write + (#try.Success _) + false + + (#try.Failure write) + (text\= input write))))) + destroy? (do ! + [destroy (!.use (:: process destroy) [])] + (wrap (#try.Success (case destroy + (#try.Success _) + false + + (#try.Failure destroy) + (text\= destruction destroy))))) + await (!.use (:: process await) [])] + (wrap (and (text\= command read) + (text\= oops error) + write? + destroy? + (i.= exit await))))] + (_.claim [/.async /.Can-Write] + (try.default false verdict))))) + ))) |