From 889139602b77e4387a6e8bfbedacc2a08703e976 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 27 Nov 2020 00:07:51 -0400 Subject: Re-named lux/data/format/context to lux/control/parser/environment. --- stdlib/source/lux/control/parser/environment.lux | 39 +++++++ stdlib/source/lux/data/collection/set.lux | 6 +- stdlib/source/lux/data/format/context.lux | 45 --------- .../compiler/language/lux/phase/analysis/case.lux | 10 +- .../language/lux/phase/analysis/case/coverage.lux | 32 +++--- .../language/lux/phase/analysis/inference.lux | 18 ++-- .../language/lux/phase/analysis/reference.lux | 4 +- .../compiler/language/lux/phase/analysis/scope.lux | 16 +-- .../language/lux/phase/analysis/structure.lux | 12 +-- .../language/lux/phase/generation/extension.lux | 4 +- .../compiler/language/lux/phase/generation/jvm.lux | 4 +- .../language/lux/phase/generation/jvm/host.lux | 10 +- .../language/lux/phase/generation/lua/case.lux | 24 ++--- .../language/lux/phase/generation/lua/function.lux | 6 +- .../language/lux/phase/generation/lua/loop.lux | 4 +- .../language/lux/phase/generation/lua/runtime.lux | 21 ++-- .../lux/phase/generation/lua/structure.lux | 8 +- .../compiler/language/lux/phase/generation/php.lux | 4 +- .../language/lux/phase/generation/python.lux | 8 +- .../language/lux/phase/generation/ruby.lux | 8 +- .../language/lux/phase/generation/ruby/case.lux | 26 ++--- .../lux/phase/generation/ruby/function.lux | 6 +- .../language/lux/phase/generation/ruby/loop.lux | 4 +- .../language/lux/phase/generation/ruby/runtime.lux | 28 ++++-- .../lux/phase/generation/ruby/structure.lux | 8 +- .../language/lux/phase/generation/scheme/case.lux | 16 +-- .../compiler/language/lux/phase/synthesis/case.lux | 56 +++++------ .../language/lux/phase/synthesis/function.lux | 38 +++---- .../compiler/language/lux/phase/synthesis/loop.lux | 12 +-- .../language/lux/phase/synthesis/variable.lux | 34 +++---- stdlib/source/lux/world/shell.lux | 24 +++-- stdlib/source/poly/lux/data/format/json.lux | 112 ++++++++++----------- stdlib/source/program/aedifex.lux | 8 +- stdlib/source/program/aedifex/artifact.lux | 14 +-- stdlib/source/program/aedifex/command/auto.lux | 23 +++-- stdlib/source/program/aedifex/command/build.lux | 40 +++----- stdlib/source/program/aedifex/command/deps.lux | 6 +- stdlib/source/program/aedifex/command/test.lux | 21 ++-- stdlib/source/program/aedifex/runtime.lux | 17 ++++ stdlib/source/spec/lux/world/shell.lux | 19 ++-- stdlib/source/test/aedifex.lux | 4 +- stdlib/source/test/aedifex/command/deps.lux | 4 +- stdlib/source/test/aedifex/input.lux | 16 ++- stdlib/source/test/aedifex/runtime.lux | 28 ++++++ stdlib/source/test/lux/control.lux | 30 +----- stdlib/source/test/lux/control/concatenative.lux | 4 +- .../source/test/lux/control/concurrency/actor.lux | 12 +-- stdlib/source/test/lux/control/concurrency/frp.lux | 26 ++--- .../test/lux/control/concurrency/semaphore.lux | 10 +- stdlib/source/test/lux/control/concurrency/stm.lux | 4 +- stdlib/source/test/lux/control/function/memo.lux | 12 +-- stdlib/source/test/lux/control/function/mixin.lux | 6 +- stdlib/source/test/lux/control/parser.lux | 26 ++++- .../source/test/lux/control/parser/environment.lux | 52 ++++++++++ stdlib/source/test/lux/control/pipe.lux | 10 +- stdlib/source/test/lux/control/security/policy.lux | 12 +-- stdlib/source/test/lux/control/try.lux | 8 +- stdlib/source/test/lux/locale/language.lux | 12 +-- stdlib/source/test/lux/locale/territory.lux | 16 +-- stdlib/source/test/lux/math.lux | 1 - stdlib/source/test/lux/meta.lux | 20 ++-- stdlib/source/test/lux/meta/annotation.lux | 10 +- .../compiler/language/lux/phase/analysis/case.lux | 48 ++++----- .../language/lux/phase/analysis/function.lux | 14 +-- .../language/lux/phase/analysis/primitive.lux | 7 +- .../language/lux/phase/analysis/reference.lux | 16 +-- .../language/lux/phase/analysis/structure.lux | 36 +++---- .../language/lux/phase/extension/analysis/lux.lux | 6 +- .../compiler/language/lux/phase/synthesis/case.lux | 26 ++--- .../language/lux/phase/synthesis/function.lux | 38 +++---- .../compiler/language/lux/phase/synthesis/loop.lux | 10 +- .../language/lux/phase/synthesis/primitive.lux | 10 +- .../language/lux/phase/synthesis/structure.lux | 6 +- .../language/lux/phase/synthesis/variable.lux | 24 ++--- .../test/lux/tool/compiler/language/lux/syntax.lux | 32 +++--- stdlib/source/test/lux/world/shell.lux | 102 +++++++++++++++++-- 76 files changed, 846 insertions(+), 647 deletions(-) create mode 100644 stdlib/source/lux/control/parser/environment.lux delete mode 100644 stdlib/source/lux/data/format/context.lux create mode 100644 stdlib/source/program/aedifex/runtime.lux create mode 100644 stdlib/source/test/aedifex/runtime.lux create mode 100644 stdlib/source/test/lux/control/parser/environment.lux (limited to 'stdlib/source') 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 [] [(#/.Simple ( _)) - (////@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 [] [( left right) @@ -78,7 +78,7 @@ (^template [] [( env quantified) - ( (list@map (replace parameter-idx replacement) env) + ( (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 [] [( left right) @@ -195,7 +195,7 @@ (^template [] [( environment quantified) - ( (list@map recur environment) quantified)]) + ( (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) (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 [] [(exception: #export ( {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 [ ] [( _) @@ -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 [ ] [(^ ( value)) - (///@wrap ( value))]) + (///\wrap ( 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 [ ] [( 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 [ ] [(^ ( value)) - (///////phase@wrap (_.when (|> value (_.= ..peek) _.not) + (///////phase\wrap (_.when (|> value (_.= ..peek) _.not) fail!))]) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] @@ -154,28 +154,28 @@ (^template [ ] [(^ ( idx)) - (///////phase@wrap ( false idx)) + (///////phase\wrap ( false idx)) (^ ( idx nextP)) (|> nextP (pattern-matching' generate archive) - (///////phase@map (_.then ( true idx))))]) + (///////phase\map (_.then ( 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 [ ] [(^ ( lefts)) - (///////phase@wrap (|> ..peek ( (_.int (.int lefts))) ..push!))]) + (///////phase\wrap (|> ..peek ( (_.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 [ ] [(^ ( value)) - (//////phase@wrap ( value))]) + (//////phase\wrap ( 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 [ ] [(^ ( value)) - (//////phase@wrap ( value))]) + (//////phase\wrap ( 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 [ ] [( 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 [ ] [(^ ( value)) - (///////phase@wrap (_.when (|> value (_.= ..peek) _.not) + (///////phase\wrap (_.when (|> value (_.= ..peek) _.not) fail!))]) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] @@ -158,28 +158,28 @@ (^template [ ] [(^ ( idx)) - (///////phase@wrap ( false idx)) + (///////phase\wrap ( false idx)) (^ ( idx nextP)) (|> nextP (pattern-matching' generate archive) - (///////phase@map (_.then ( true idx))))]) + (///////phase\map (_.then ( 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 [ ] [(^ ( lefts)) - (///////phase@wrap (|> ..peek ( (_.int (.int lefts))) ..push!))]) + (///////phase\wrap (|> ..peek ( (_.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 [ ] [( 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 [ <=>] [(^ ( value)) - (////@wrap (_.when (|> value (<=> cursor-top) _.not/1) + (////\wrap (_.when (|> value (<=> 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 [ ] [(^ ( idx)) - (////@wrap (_.let (list [@temp (|> idx .int _.int (//runtime.sum//get cursor-top ))]) + (////\wrap (_.let (list [@temp (|> idx .int _.int (//runtime.sum//get cursor-top ))]) (_.if (_.null?/1 @temp) fail-pm! (push-cursor! @temp))))]) @@ -134,7 +134,7 @@ (^template [ ] [(^ ( idx)) - (////@wrap (push-cursor! ( (_.int (.int idx)) cursor-top)))]) + (////\wrap (push-cursor! ( (_.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 [ ] [( test) - (///@map (function (_ then) + (///\map (function (_ then) ( [( 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 ) [[(#///analysis.Bind ) @@ -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 )) (^ (/.function/apply [funcS' argsS'])) - (wrap (/.function/apply [funcS' (list@compose argsS' argsS)])) + (wrap (/.function/apply [funcS' (list\compose argsS' argsS)])) _ (wrap ))))))) @@ -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 [] [( 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 [] [( [[test then] tail]) ( [[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 [ ] + [(def: #export + Exit + )] + + [+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 [ (template [ ] [(do ! @@ -122,28 +120,28 @@ [date.Date date.codec] [day.Day day.codec] [month.Month month.codec])] - (do {! p.monad} + (do {! <>.monad} [*env* .env #let [@JSON\encode (: (-> Type Code) (function (_ type) (` (-> (~ (poly.to-code *env* type)) /.JSON))))] inputT .peek] - ($_ p.either + ($_ <>.either