diff options
Diffstat (limited to '')
52 files changed, 538 insertions, 349 deletions
diff --git a/stdlib/source/lux/platform/compiler.lux b/stdlib/source/lux/platform/compiler.lux index d6c6d82d9..b4fdd541e 100644 --- a/stdlib/source/lux/platform/compiler.lux +++ b/stdlib/source/lux/platform/compiler.lux @@ -7,7 +7,6 @@ [collection ["." dictionary (#+ Dictionary)]]] [world - ["." binary (#+ Binary)] ["." file (#+ File)]]] [/ [meta @@ -16,29 +15,32 @@ [descriptor (#+ Module)] [document (#+ Document)]]]]) -(type: #export Code Text) +(type: #export Code + Text) -(type: #export Parameter Text) +(type: #export Parameter + Text) (type: #export Input {#module Module #file File + #hash Nat #code Code}) -(type: #export Output - (Dictionary Text Binary)) +(type: #export (Output o) + (Dictionary Text o)) -(type: #export (Compilation d) +(type: #export (Compilation d o) {#dependencies (List Module) #process (-> Archive - (Error (Either (Compilation d) - [(Document d) Output])))}) + (Error (Either (Compilation d o) + [(Document d) (Output o)])))}) -(type: #export (Compiler d) - (-> (Key d) (List Parameter) Input (Compilation d))) +(type: #export (Compiler d o) + (-> Input (Compilation d o))) -(type: #export (Importer !) - (-> (file.System !) Module Archive (! (Error Archive)))) +(type: #export (Instancer d o) + (-> (Key d) (List Parameter) (Compiler d o))) (exception: #export (cannot-compile {module Module}) (ex.report ["Module" module])) diff --git a/stdlib/source/lux/platform/compiler/cli.lux b/stdlib/source/lux/platform/compiler/cli.lux index 55ce35145..7e92b2c34 100644 --- a/stdlib/source/lux/platform/compiler/cli.lux +++ b/stdlib/source/lux/platform/compiler/cli.lux @@ -4,10 +4,12 @@ ["p" parser]] ["." cli (#+ CLI)] [world - [file (#+ File)]]]) + [file (#+ File)]]] + [/// + [importer (#+ Source)]]) (type: #export Configuration - {#sources (List File) + {#sources (List Source) #target File #module Text}) diff --git a/stdlib/source/lux/platform/compiler/default/evaluation.lux b/stdlib/source/lux/platform/compiler/default/evaluation.lux index 157596e84..1f21304ca 100644 --- a/stdlib/source/lux/platform/compiler/default/evaluation.lux +++ b/stdlib/source/lux/platform/compiler/default/evaluation.lux @@ -25,12 +25,12 @@ (translation.Phase anchor expression statement) Eval)) (function (eval count type exprC) - (do phase.Monad<Operation> + (do phase.monad [exprA (type.with-type type (expressionA.compile exprC))] - (phase.lift (do error.Monad<Error> + (phase.lift (do error.monad [exprS (|> exprA expressionS.phase (phase.run synthesis-state))] (phase.run translation-state - (do phase.Monad<Operation> + (do phase.monad [exprO (translate exprS)] (translation.evaluate! (format "eval" (%n count)) exprO)))))))) diff --git a/stdlib/source/lux/platform/compiler/default/init.lux b/stdlib/source/lux/platform/compiler/default/init.lux index 012ab3ea9..b71596150 100644 --- a/stdlib/source/lux/platform/compiler/default/init.lux +++ b/stdlib/source/lux/platform/compiler/default/init.lux @@ -6,7 +6,7 @@ [data ["." product] ["." error (#+ Error)] - ["." text ("text/." Hash<Text>)] + ["." text ("text/." hash)] [collection ["." dictionary]]] ["." macro] @@ -54,7 +54,7 @@ (def: refresh (All [anchor expression statement] (statement.Operation anchor expression statement Any)) - (do phase.Monad<Operation> + (do phase.monad [[bundle state] phase.get-state #let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state) (get@ [#statement.translation #statement.state] state) @@ -114,7 +114,7 @@ (def: (begin hash input) (-> Nat ///.Input <Operation>) (statement.lift-analysis - (do phase.Monad<Operation> + (do phase.monad [#let [module (get@ #///.module input)] _ (module.create hash module) _ (analysis.set-current-module module)] @@ -127,7 +127,7 @@ (def: (iteration reader) (-> Reader <Operation>) - (do phase.Monad<Operation> + (do phase.monad [code (statement.lift-analysis (..read reader)) _ (totalS.phase code)] @@ -135,7 +135,7 @@ (def: (loop module) (-> Module <Operation>) - (do phase.Monad<Operation> + (do phase.monad [reader (statement.lift-analysis (..reader module syntax.no-aliases))] (function (_ state) @@ -151,7 +151,7 @@ (def: (compile hash input) (-> Nat ///.Input <Operation>) - (do phase.Monad<Operation> + (do phase.monad [#let [module (get@ #///.module input)] _ (..begin hash input) _ (..loop module)] @@ -174,11 +174,11 @@ dependencies (default-dependencies prelude input)] {#///.dependencies dependencies #///.process (function (_ archive) - (do error.Monad<Error> + (do error.monad [[state' analysis-module] (phase.run' state (: (All [anchor expression statement] (statement.Operation anchor expression statement .Module)) - (do phase.Monad<Operation> + (do phase.monad [_ (compile hash input)] (statement.lift-analysis (extension.lift @@ -189,7 +189,7 @@ #descriptor.references dependencies #descriptor.state #.Compiled}]] (wrap (#.Right [(document.write key descriptor analysis-module) - (dictionary.new text.Hash<Text>)]))))}))) + (dictionary.new text.hash)]))))}))) (def: #export key (Key .Module) diff --git a/stdlib/source/lux/platform/compiler/default/platform.lux b/stdlib/source/lux/platform/compiler/default/platform.lux index 10dfd6ebb..7e3846c09 100644 --- a/stdlib/source/lux/platform/compiler/default/platform.lux +++ b/stdlib/source/lux/platform/compiler/default/platform.lux @@ -28,7 +28,7 @@ ## (def: (write-module target-dir file-name module-name module outputs) ## (-> File Text Text Module Outputs (Process Any)) -## (do io.Monad<Process> +## (do (error.with-error io.monad) ## [_ (monad.map @ (product.uncurry (&io.write target-dir)) ## (dictionary.entries outputs))] ## (&io.write target-dir @@ -48,7 +48,7 @@ (phase.run' (init.state (get@ #host platform) (get@ #phase platform) translation-bundle)) - (:: error.Functor<Error> map product.left) + (:: error.functor map product.left) (:: (get@ #file-system platform) lift)) ## (case (runtimeT.translate ## (initL.compiler (io.run js.init)) diff --git a/stdlib/source/lux/platform/compiler/default/syntax.lux b/stdlib/source/lux/platform/compiler/default/syntax.lux index a1bb9f3ea..c76857aab 100644 --- a/stdlib/source/lux/platform/compiler/default/syntax.lux +++ b/stdlib/source/lux/platform/compiler/default/syntax.lux @@ -31,7 +31,11 @@ ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] - ["." number] + [number + ["." nat] + ["." int] + ["." rev] + ["." frac]] ["." text [lexer (#+ Offset)] format] @@ -82,7 +86,7 @@ ) (type: #export Aliases (Dictionary Text Text)) -(def: #export no-aliases Aliases (dictionary.new text.Hash<Text>)) +(def: #export no-aliases Aliases (dictionary.new text.hash)) (def: #export prelude "lux") @@ -302,8 +306,8 @@ (def: no-exponent Offset 0) -(with-expansions [<int-output> (as-is (!number-output start end number.Codec<Text,Int> #.Int)) - <frac-output> (as-is (!number-output start end number.Codec<Text,Frac> #.Frac)) +(with-expansions [<int-output> (as-is (!number-output start end int.decimal #.Int)) + <frac-output> (as-is (!number-output start end frac.decimal #.Frac)) <failure> (ex.throw unrecognized-input [where "Frac" source-code offset])] (def: (parse-frac source-code//size start [where offset source-code]) (-> Nat Offset Parser) @@ -351,8 +355,8 @@ (recur (!inc g!end)) (!number-output start g!end <codec> <tag>)))))] - [!parse-nat number.Codec<Text,Nat> #.Nat] - [!parse-rev number.Codec<Text,Rev> #.Rev] + [!parse-nat nat.decimal #.Nat] + [!parse-rev rec.decimal #.Rev] ) (template: (!parse-signed source-code//size offset where source-code @end) diff --git a/stdlib/source/lux/platform/compiler/host/scheme.lux b/stdlib/source/lux/platform/compiler/host/scheme.lux index 8d5cbdbcd..f3550ad88 100644 --- a/stdlib/source/lux/platform/compiler/host/scheme.lux +++ b/stdlib/source/lux/platform/compiler/host/scheme.lux @@ -7,7 +7,7 @@ ["." text format] [collection - ["." list ("list/." Functor<List> Fold<List>)]]] + ["." list ("list/." functor fold)]]] [type abstract]]) diff --git a/stdlib/source/lux/platform/compiler/meta/archive.lux b/stdlib/source/lux/platform/compiler/meta/archive.lux index f36a0b754..c318bfaf7 100644 --- a/stdlib/source/lux/platform/compiler/meta/archive.lux +++ b/stdlib/source/lux/platform/compiler/meta/archive.lux @@ -38,14 +38,14 @@ (abstract: #export Archive {} - (Dictionary Text <Document>) + (Dictionary Text [Descriptor <Document>]) (def: #export empty Archive - (:abstraction (dictionary.new text.Hash<Text>))) + (:abstraction (dictionary.new text.hash))) - (def: #export (add name document archive) - (-> Module <Document> Archive (Error Archive)) + (def: #export (add name descriptor document archive) + (-> Module Descriptor <Document> Archive (Error Archive)) (case (dictionary.get name (:representation archive)) (#.Some existing) (if (is? document existing) @@ -53,11 +53,13 @@ (ex.throw cannot-replace-document [name existing document])) #.None - (#error.Success (:abstraction (dictionary.put name document - (:representation archive)))))) + (#error.Success (|> archive + :representation + (dictionary.put name [descriptor document]) + :abstraction)))) (def: #export (find name archive) - (-> Module Archive (Error <Document>)) + (-> Module Archive (Error [Descriptor <Document>])) (case (dictionary.get name (:representation archive)) (#.Some document) (#error.Success document) @@ -67,9 +69,9 @@ (def: #export (merge additions archive) (-> Archive Archive (Error Archive)) - (monad.fold error.Monad<Error> - (function (_ [name' document'] archive') - (..add name' document' archive')) + (monad.fold error.monad + (function (_ [name' descriptor+document'] archive') + (..add name' descriptor+document' archive')) archive (dictionary.entries (:representation additions)))) )) diff --git a/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux index 6c7e6744e..328240e6c 100644 --- a/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/lux/platform/compiler/meta/archive/descriptor.lux @@ -1,5 +1,8 @@ (.module: [lux (#- Module) + [data + [collection + [set (#+ Set)]]] [world [file (#+ File)]]]) @@ -9,5 +12,5 @@ {#hash Nat #name Module #file File - #references (List Module) + #references (Set Module) #state Module-State}) diff --git a/stdlib/source/lux/platform/compiler/meta/archive/document.lux b/stdlib/source/lux/platform/compiler/meta/archive/document.lux index b99ff9b72..5c077080f 100644 --- a/stdlib/source/lux/platform/compiler/meta/archive/document.lux +++ b/stdlib/source/lux/platform/compiler/meta/archive/document.lux @@ -11,25 +11,23 @@ [// ["." signature (#+ Signature)] ["." key (#+ Key)] - ["." descriptor (#+ Module Descriptor)]]) + [descriptor (#+ Module)]]) ## Document -(exception: #export (invalid-signature {module Module} {expected Signature} {actual Signature}) - (ex.report ["Module" module] - ["Expected" (signature.description expected)] +(exception: #export (invalid-signature {expected Signature} {actual Signature}) + (ex.report ["Expected" (signature.description expected)] ["Actual" (signature.description actual)])) (abstract: #export (Document d) {} {#signature Signature - #descriptor Descriptor #content d} (def: #export (read key document) (All [d] (-> (Key d) (Document Any) (Error d))) - (let [[document//signature document//descriptor document//content] (:representation document)] - (if (:: signature.Equivalence<Signature> = + (let [[document//signature document//content] (:representation document)] + (if (:: signature.equivalence = (key.signature key) document//signature) (#error.Success (:share [e] @@ -37,14 +35,12 @@ key} {e document//content})) - (ex.throw invalid-signature [(get@ #descriptor.name document//descriptor) - (key.signature key) + (ex.throw invalid-signature [(key.signature key) document//signature])))) - (def: #export (write key descriptor content) - (All [d] (-> (Key d) Descriptor d (Document d))) + (def: #export (write key content) + (All [d] (-> (Key d) d (Document d))) (:abstraction {#signature (key.signature key) - #descriptor descriptor #content content})) (def: #export signature diff --git a/stdlib/source/lux/platform/compiler/meta/archive/signature.lux b/stdlib/source/lux/platform/compiler/meta/archive/signature.lux index 5332b79c3..fb96aec58 100644 --- a/stdlib/source/lux/platform/compiler/meta/archive/signature.lux +++ b/stdlib/source/lux/platform/compiler/meta/archive/signature.lux @@ -14,9 +14,9 @@ {#name Name #version Version}) -(def: #export Equivalence<Signature> +(def: #export equivalence (Equivalence Signature) - (equivalence.product name.Equivalence<Name> text.Equivalence<Text>)) + (equivalence.product name.equivalence text.equivalence)) (def: #export (description signature) (-> Signature Text) diff --git a/stdlib/source/lux/platform/compiler/meta/cache.lux b/stdlib/source/lux/platform/compiler/meta/cache.lux index ceed96164..c54fac935 100644 --- a/stdlib/source/lux/platform/compiler/meta/cache.lux +++ b/stdlib/source/lux/platform/compiler/meta/cache.lux @@ -5,7 +5,7 @@ ["ex" exception (#+ exception:)] pipe] [data - ["." bit ("bit/." Equivalence<Bit>)] + ["." bit ("bit/." equivalence)] ["." maybe] ["." error] ["." product] @@ -14,7 +14,7 @@ ["." text [format (#- Format)]] [collection - ["." list ("list/." Functor<List> Fold<List>)] + ["." list ("list/." functor fold)] ["dict" dictionary (#+ Dictionary)] ["." set (#+ Set)]]] [world @@ -122,12 +122,12 @@ (do (:: System<m> &monad) [document' (:: System<m> read (io/archive.document System<m> root module)) [module' source-code] (io/context.read System<m> contexts module) - #let [current-hash (:: text.Hash<Text> hash source-code)]] - (case (do error.Monad<Error> + #let [current-hash (:: text.hash hash source-code)]] + (case (do error.monad [[signature descriptor content] (binary.read (..document binary) document') #let [[document-hash _file references _state] descriptor] _ (ex.assert mismatched-signature [module (get@ #archive.signature key) signature] - (:: archive.Equivalence<Signature> = + (:: archive.equivalence = (get@ #archive.signature key) signature)) _ (ex.assert stale-document [module current-hash document-hash] @@ -157,13 +157,13 @@ #.None archive)) (: (Dictionary Text [(List Module) (Ex [d] (Document d))]) - (dict.new text.Hash<Text>))))])) + (dict.new text.hash))))])) #let [candidate-entries (dict.entries candidate) candidate-dependencies (list/map (product.both id product.left) candidate-entries) candidate-archive (|> candidate-entries (list/map (product.both id product.right)) - (dict.from-list text.Hash<Text>)) + (dict.from-list text.hash)) graph (|> candidate dict.entries (list/map (product.both id product.left)) diff --git a/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux b/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux index e63fa192b..d18b92d59 100644 --- a/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux +++ b/stdlib/source/lux/platform/compiler/meta/cache/dependency.lux @@ -3,14 +3,14 @@ [data ["." text] [collection - [list ("list/." Functor<List> Fold<List>)] + [list ("list/." functor fold)] ["dict" dictionary (#+ Dictionary)]]]] [///io (#+ Module)] [///archive (#+ Archive)]) (type: #export Graph (Dictionary Module (List Module))) -(def: #export empty Graph (dict.new text.Hash<Text>)) +(def: #export empty Graph (dict.new text.hash)) (def: #export (add to from) (-> Module Module Graph Graph) diff --git a/stdlib/source/lux/platform/compiler/phase.lux b/stdlib/source/lux/platform/compiler/phase.lux index a81d5dfa7..203ed73bc 100644 --- a/stdlib/source/lux/platform/compiler/phase.lux +++ b/stdlib/source/lux/platform/compiler/phase.lux @@ -6,7 +6,7 @@ [monad (#+ do)]] [data ["." product] - ["." error (#+ Error) ("error/." Functor<Error>)] + ["." error (#+ Error) ("error/." functor)] ["." text format]] [time @@ -19,8 +19,8 @@ (type: #export (Operation s o) (state.State' Error s o)) -(def: #export Monad<Operation> - (state.Monad<State'> error.Monad<Error>)) +(def: #export monad + (state.monad error.monad)) (type: #export (Phase s i o) (-> i (Operation s o))) @@ -35,7 +35,7 @@ (-> s (Operation s o) (Error o))) (|> state operation - (:: error.Monad<Error> map product.right))) + (:: error.monad map product.right))) (def: #export get-state (All [s o] @@ -55,17 +55,17 @@ (Operation s' o) (Operation s o))) (function (_ state) - (do error.Monad<Error> + (do error.monad [[state' output] (operation (get state))] (wrap [(set state' state) output])))) (def: #export fail (-> Text Operation) - (|>> error.fail (state.lift error.Monad<Error>))) + (|>> error.fail (state.lift error.monad))) (def: #export (throw exception parameters) (All [e] (-> (Exception e) e Operation)) - (state.lift error.Monad<Error> + (state.lift error.monad (ex.throw exception parameters))) (def: #export (lift error) @@ -75,7 +75,7 @@ (syntax: #export (assert exception message test) (wrap (list (` (if (~ test) - (:: ..Monad<Operation> (~' wrap) []) + (:: ..monad (~' wrap) []) (..throw (~ exception) (~ message))))))) (def: #export (with-stack exception message action) @@ -94,7 +94,7 @@ (Phase s1 t o) (Phase [s0 s1] i o))) (function (_ input [pre/state post/state]) - (do error.Monad<Error> + (do error.monad [[pre/state' temp] (pre input pre/state) [post/state' output] (post temp post/state)] (wrap [[pre/state' post/state'] output])))) @@ -102,7 +102,7 @@ (def: #export (timed definition description operation) (All [s a] (-> Name Text (Operation s a) (Operation s a))) - (do Monad<Operation> + (do ..monad [_ (wrap []) #let [pre (io.run instant.now)] output operation diff --git a/stdlib/source/lux/platform/compiler/phase/analysis.lux b/stdlib/source/lux/platform/compiler/phase/analysis.lux index c5256436f..d1bd6a986 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis.lux @@ -6,10 +6,10 @@ ["." product] ["." error] ["." maybe] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format] [collection - ["." list ("list/." Functor<List> Fold<List>)]]] + ["." list ("list/." functor fold)]]] ["." function]] [// ["." extension (#+ Extension)] diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/case.lux b/stdlib/source/lux/platform/compiler/phase/analysis/case.lux index d7b020932..343d4c813 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/case.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/case.lux @@ -10,7 +10,7 @@ [text format] [collection - ["." list ("list/." Fold<List> Monoid<List> Functor<List>)]]] + ["." list ("list/." fold monoid functor)]]] ["." type ["." check]] ["." macro @@ -69,7 +69,7 @@ caseT caseT] (.case caseT (#.Var id) - (do ///.Monad<Operation> + (do ///.monad [?caseT' (//type.with-env (check.read id))] (.case ?caseT' @@ -86,7 +86,7 @@ (recur (#.Cons env envs) unquantifiedT) (#.ExQ _) - (do ///.Monad<Operation> + (do ///.monad [[ex-id exT] (//type.with-env check.existential)] (recur envs (maybe.assume (type.apply (list exT) caseT)))) @@ -94,9 +94,9 @@ (#.Apply inputT funcT) (.case funcT (#.Var funcT-id) - (do ///.Monad<Operation> + (do ///.monad [funcT' (//type.with-env - (do check.Monad<Check> + (do check.monad [?funct' (check.read funcT-id)] (.case ?funct' (#.Some funct') @@ -119,15 +119,15 @@ type.flatten-tuple (list/map (re-quantify envs)) type.tuple - (:: ///.Monad<Operation> wrap)) + (:: ///.monad wrap)) _ - (:: ///.Monad<Operation> wrap (re-quantify envs caseT))))) + (:: ///.monad wrap (re-quantify envs caseT))))) (def: (analyse-primitive type inputT cursor output next) (All [a] (-> Type Type Cursor Pattern (Operation a) (Operation [Pattern a]))) (//.with-cursor cursor - (do ///.Monad<Operation> + (do ///.monad [_ (//type.with-env (check.check inputT type)) outputA next] @@ -154,7 +154,7 @@ (.case pattern [cursor (#.Identifier ["" name])] (//.with-cursor cursor - (do ///.Monad<Operation> + (do ///.monad [outputA (scope.with-local [name inputT] next) idx scope.next-local] @@ -176,7 +176,7 @@ [cursor (#.Tuple sub-patterns)] (//.with-cursor cursor - (do ///.Monad<Operation> + (do ///.monad [inputT' (simplify-case inputT)] (.case inputT' (#.Product _) @@ -216,7 +216,7 @@ ))) [cursor (#.Record record)] - (do ///.Monad<Operation> + (do ///.monad [record (structure.normalize record) [members recordT] (structure.order record) _ (//type.with-env @@ -229,7 +229,7 @@ (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))]) (//.with-cursor cursor - (do ///.Monad<Operation> + (do ///.monad [inputT' (simplify-case inputT)] (.case inputT' (#.Sum _) @@ -239,7 +239,7 @@ (.case (list.nth idx flat-sum) (^multi (#.Some caseT) (n/< num-cases idx)) - (do ///.Monad<Operation> + (do ///.monad [[testP nextA] (if (and (n/> num-cases size-sum) (n/= (dec num-cases) idx)) (analyse-pattern #.None @@ -262,7 +262,7 @@ (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))]) (//.with-cursor cursor - (do ///.Monad<Operation> + (do ///.monad [tag (extension.lift (macro.normalize tag)) [idx group variantT] (extension.lift (macro.resolve-tag tag)) _ (//type.with-env @@ -277,7 +277,7 @@ (-> Phase Code (List [Code Code]) (Operation Analysis)) (.case branches (#.Cons [patternH bodyH] branchesT) - (do ///.Monad<Operation> + (do ///.monad [[inputT inputA] (//type.with-inference (analyse inputC)) outputH (analyse-pattern #.None inputT patternH (analyse bodyH)) @@ -287,7 +287,7 @@ branchesT) outputHC (|> outputH product.left coverage.determine) outputTC (monad.map @ (|>> product.left coverage.determine) outputT) - _ (.case (monad.fold error.Monad<Error> coverage.merge outputHC outputTC) + _ (.case (monad.fold error.monad coverage.merge outputHC outputTC) (#error.Success coverage) (///.assert non-exhaustive-pattern-matching [inputC branches coverage] (coverage.exhaustive? coverage)) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux b/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux index bdf524f73..b21df1fcd 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/case/coverage.lux @@ -5,16 +5,16 @@ ["ex" exception (#+ exception:)] equivalence] [data - [bit ("bit/." Equivalence<Bit>)] + [bit ("bit/." equivalence)] ["." number] - ["." error (#+ Error) ("error/." Monad<Error>)] + ["." error (#+ Error) ("error/." monad)] ["." maybe] ["." text format] [collection - ["." list ("list/." Functor<List> Fold<List>)] + ["." list ("list/." functor fold)] ["." dictionary (#+ Dictionary)]]]] - ["." //// ("operation/." Monad<Operation>)] + ["." //// ("operation/." monad)] ["." /// (#+ Pattern Variant Operation)]) (exception: #export (invalid-tuple-pattern) @@ -119,11 +119,11 @@ (////.throw invalid-tuple-pattern []) (#.Cons lastP prevsP+) - (do ////.Monad<Operation> + (do ////.monad [lastC (determine lastP)] - (monad.fold ////.Monad<Operation> + (monad.fold ////.monad (function (_ leftP rightC) - (do ////.Monad<Operation> + (do ////.monad [leftC (determine leftP)] (case rightC #Exhaustive @@ -136,7 +136,7 @@ ## Variant patterns can be shown to be exhaustive if all the possible ## cases are handled exhaustively. (#///.Complex (#///.Variant [lefts right? value])) - (do ////.Monad<Operation> + (do ////.monad [value-coverage (determine value) #let [idx (if right? (inc lefts) @@ -144,7 +144,7 @@ (wrap (#Variant (if right? (#.Some idx) #.None) - (|> (dictionary.new number.Hash<Nat>) + (|> (dictionary.new number.hash) (dictionary.put idx value-coverage))))))) (def: (xor left right) @@ -183,7 +183,7 @@ [(#Variant allR casesR) (#Variant allS casesS)] (and (n/= (cases allR) (cases allS)) - (:: (dictionary.Equivalence<Dictionary> =) = casesR casesS)) + (:: (dictionary.equivalence =) = casesR casesS)) [(#Seq leftR rightR) (#Seq leftS rightS)] (and (= leftR leftS) @@ -200,7 +200,7 @@ _ #0))) -(open: "coverage/." Equivalence<Coverage>) +(open: "coverage/." ..equivalence) (exception: #export (variants-do-not-match {addition-cases Nat} {so-far-cases Nat}) (ex.report ["So-far Cases" (%n so-far-cases)] @@ -229,11 +229,11 @@ (not (n/= addition-cases so-far-cases))) (ex.throw variants-do-not-match [addition-cases so-far-cases]) - (:: (dictionary.Equivalence<Dictionary> Equivalence<Coverage>) = casesSF casesA) + (:: (dictionary.equivalence ..equivalence) = casesSF casesA) (ex.throw redundant-pattern [so-far addition]) ## else - (do error.Monad<Error> + (do error.monad [casesM (monad.fold @ (function (_ [tagA coverageA] casesSF') (case (dictionary.get tagA casesSF') @@ -263,7 +263,7 @@ (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)] ## Same prefix [#1 #0] - (do error.Monad<Error> + (do error.monad [rightM (merge rightA rightSF)] (if (exhaustive? rightM) ## If all that follows is exhaustive, then it can be safely dropped @@ -274,7 +274,7 @@ ## Same suffix [#0 #1] - (do error.Monad<Error> + (do error.monad [leftM (merge leftA leftSF)] (wrap (#Seq leftM rightA))) @@ -314,7 +314,7 @@ ## This process must be repeated until no further productive ## merges can be done. [_ (#Alt leftS rightS)] - (do error.Monad<Error> + (do error.monad [#let [fuse-once (: (-> Coverage (List Coverage) (Error [(Maybe Coverage) (List Coverage)])) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux b/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux index 1da6520a5..3ce70fe9b 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/expression.lux @@ -26,7 +26,7 @@ (def: #export (compile code) Phase - (do ///.Monad<Operation> + (do ///.monad [expectedT (extension.lift macro.expected-type)] (let [[cursor code'] code] ## The cursor must be set in the state for the sake diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/function.lux b/stdlib/source/lux/platform/compiler/phase/analysis/function.lux index a996457d9..a95412e42 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/function.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/function.lux @@ -8,7 +8,7 @@ ["." text format] [collection - ["." list ("list/." Fold<List> Monoid<List> Monad<List>)]]] + ["." list ("list/." fold monoid monad)]]] ["." type ["." check]] ["." macro]] @@ -35,7 +35,7 @@ (def: #export (function analyse function-name arg-name body) (-> Phase Text Text Code (Operation Analysis)) - (do ///.Monad<Operation> + (do ///.monad [functionT (extension.lift macro.expected-type)] (loop [expectedT functionT] (///.with-stack cannot-analyse [expectedT function-name arg-name body] @@ -97,6 +97,6 @@ (def: #export (apply analyse functionT functionA argsC+) (-> Phase Type Analysis (List Code) (Operation Analysis)) (<| (///.with-stack cannot-apply [functionT argsC+]) - (do ///.Monad<Operation> + (do ///.monad [[applyT argsA+] (inference.general analyse functionT argsC+)]) (wrap (//.apply [functionA argsA+])))) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux b/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux index 010bdc437..7ce10cb32 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/inference.lux @@ -8,11 +8,11 @@ ["." text format] [collection - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] ["." type ["." check]] ["." macro]] - ["." /// ("operation/." Monad<Operation>) + ["." /// ("operation/." monad) ["." extension]] [// (#+ Tag Analysis Operation Phase)] ["." //type]) @@ -84,7 +84,7 @@ (def: new-named-type (Operation Type) - (do ///.Monad<Operation> + (do ///.monad [cursor (extension.lift macro.cursor) [ex-id _] (//type.with-env check.existential)] (wrap (named-type cursor ex-id)))) @@ -100,7 +100,7 @@ (-> Phase Type (List Code) (Operation [Type (List Analysis)])) (case args #.Nil - (do ///.Monad<Operation> + (do ///.monad [_ (//type.infer inferT)] (wrap [inferT (list)])) @@ -110,12 +110,12 @@ (general analyse unnamedT args) (#.UnivQ _) - (do ///.Monad<Operation> + (do ///.monad [[var-id varT] (//type.with-env check.var)] (general analyse (maybe.assume (type.apply (list varT) inferT)) args)) (#.ExQ _) - (do ///.Monad<Operation> + (do ///.monad [[var-id varT] (//type.with-env check.var) output (general analyse (maybe.assume (type.apply (list varT) inferT)) @@ -146,7 +146,7 @@ ## avoided in Lux code, since the inference algorithm can piece ## things together more easily. (#.Function inputT outputT) - (do ///.Monad<Operation> + (do ///.monad [[outputT' args'A] (general analyse outputT args') argA (<| (///.with-stack cannot-infer-argument [inputT argC]) (//type.with-type inputT) @@ -154,7 +154,7 @@ (wrap [outputT' (list& argA args'A)])) (#.Var infer-id) - (do ///.Monad<Operation> + (do ///.monad [?inferT' (//type.with-env (check.read infer-id))] (case ?inferT' (#.Some inferT') @@ -176,7 +176,7 @@ (^template [<tag>] (<tag> env bodyT) - (do ///.Monad<Operation> + (do ///.monad [bodyT+ (record bodyT)] (wrap (<tag> env bodyT+)))) ([#.UnivQ] @@ -203,13 +203,13 @@ currentT inferT] (case currentT (#.Named name unnamedT) - (do ///.Monad<Operation> + (do ///.monad [unnamedT+ (recur depth unnamedT)] (wrap unnamedT+)) (^template [<tag>] (<tag> env bodyT) - (do ///.Monad<Operation> + (do ///.monad [bodyT+ (recur (inc depth) bodyT)] (wrap (<tag> env bodyT+)))) ([#.UnivQ] diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux b/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux index 64dabaf43..d02478454 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/macro.lux @@ -9,7 +9,7 @@ format] [collection [array (#+ Array)] - [list ("list/." Functor<List>)]]] + [list ("list/." functor)]]] ["." macro] ["." host (#+ import:)]] ["." ///]) @@ -49,7 +49,7 @@ (def: #export (expand name macro inputs) (-> Name Macro (List Code) (Meta (List Code))) (function (_ state) - (do error.Monad<Error> + (do error.monad [apply-method (|> macro (:coerce Object) (Object::getClass) @@ -69,7 +69,7 @@ (def: #export (expand-one name macro inputs) (-> Name Macro (List Code) (Meta Code)) - (do macro.Monad<Meta> + (do macro.monad [expansion (expand name macro inputs)] (case expansion (^ (list single)) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/module.lux b/stdlib/source/lux/platform/compiler/phase/analysis/module.lux index a8f6bda03..9905ee2dc 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/module.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/module.lux @@ -5,11 +5,11 @@ ["ex" exception (#+ exception:)] pipe] [data - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format] ["." error] [collection - ["." list ("list/." Fold<List> Functor<List>)] + ["." list ("list/." fold functor)] [dictionary ["." plist]]]] ["." macro]] @@ -63,7 +63,7 @@ (def: #export (set-annotations annotations) (-> Code (Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [self-name (extension.lift macro.current-module-name) self (extension.lift macro.current-module)] (case (get@ #.module-annotations self) @@ -80,7 +80,7 @@ (def: #export (import module) (-> Text (Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [self-name (extension.lift macro.current-module-name)] (extension.lift (function (_ state) @@ -91,7 +91,7 @@ (def: #export (alias alias module) (-> Text Text (Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [self-name (extension.lift macro.current-module-name)] (extension.lift (function (_ state) @@ -113,7 +113,7 @@ (def: #export (define name definition) (-> Text Definition (Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [self-name (extension.lift macro.current-module-name) self (extension.lift macro.current-module)] (extension.lift @@ -144,7 +144,7 @@ (def: #export (with-module hash name action) (All [a] (-> Nat Text (Operation a) (Operation [Module a]))) - (do ///.Monad<Operation> + (do ///.monad [_ (create hash name) output (//.with-current-module name action) @@ -210,7 +210,7 @@ (def: (ensure-undeclared-tags module-name tags) (-> Text (List Tag) (Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [bindings (..tags module-name) _ (monad.map @ (function (_ tag) @@ -225,7 +225,7 @@ (def: #export (declare-tags tags exported? type) (-> (List Tag) Bit Type (Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [self-name (extension.lift macro.current-module-name) [type-module type-name] (case type (#.Named type-name _) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux b/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux index bd42825d3..b46983293 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/primitive.lux @@ -10,7 +10,7 @@ (do-template [<name> <type> <tag>] [(def: #export (<name> value) (-> <type> (Operation Analysis)) - (do ///.Monad<Operation> + (do ///.monad [_ (typeA.infer <type>)] (wrap (#//.Primitive (<tag> value)))))] @@ -24,6 +24,6 @@ (def: #export unit (Operation Analysis) - (do ///.Monad<Operation> + (do ///.monad [_ (typeA.infer Any)] (wrap (#//.Primitive #//.Unit)))) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux b/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux index 30da3e60f..b7f41a81a 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/reference.lux @@ -5,7 +5,7 @@ ["ex" exception (#+ exception:)]] ["." macro] [data - [text ("text/." Equivalence<Text>) + [text ("text/." equivalence) format]]] ["." // (#+ Analysis Operation) ["." scope] @@ -26,7 +26,7 @@ (def: (definition def-name) (-> Name (Operation Analysis)) (with-expansions [<return> (wrap (|> def-name reference.constant #//.Reference))] - (do ///.Monad<Operation> + (do ///.monad [[actualT def-anns _] (extension.lift (macro.find-def def-name))] (case (macro.get-identifier-ann (name-of #.alias) def-anns) (#.Some real-def-name) @@ -49,7 +49,7 @@ (def: (variable var-name) (-> Text (Operation (Maybe Analysis))) - (do ///.Monad<Operation> + (do ///.monad [?var (scope.find var-name)] (case ?var (#.Some [actualT ref]) @@ -64,7 +64,7 @@ (-> Name (Operation Analysis)) (case reference ["" simple-name] - (do ///.Monad<Operation> + (do ///.monad [?var (variable simple-name)] (case ?var (#.Some varA) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux b/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux index 8cd55e198..c724edad2 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/scope.lux @@ -4,13 +4,13 @@ monad ["ex" exception (#+ exception:)]] [data - [text ("text/." Equivalence<Text>) + [text ("text/." equivalence) format] - ["." maybe ("maybe/." Monad<Maybe>)] + ["." maybe ("maybe/." monad)] ["." product] ["e" error] [collection - ["." list ("list/." Functor<List> Fold<List> Monoid<List>)] + ["." list ("list/." functor fold monoid)] [dictionary ["." plist]]]]] [// (#+ Operation Phase) diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux b/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux index 43cb8e0d2..21b2b6e2b 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/structure.lux @@ -13,7 +13,7 @@ [text format] [collection - ["." list ("list/." Functor<List>)] + ["." list ("list/." functor)] ["dict" dictionary (#+ Dictionary)]]] ["." type ["." check]] @@ -82,7 +82,7 @@ (def: #export (sum analyse tag valueC) (-> Phase Nat Code (Operation Analysis)) - (do ///.Monad<Operation> + (do ///.monad [expectedT (extension.lift macro.expected-type)] (///.with-stack cannot-analyse-variant [expectedT tag valueC] (case expectedT @@ -160,7 +160,7 @@ (def: (typed-product analyse members) (-> Phase (List Code) (Operation Analysis)) - (do ///.Monad<Operation> + (do ///.monad [expectedT (extension.lift macro.expected-type) membersA+ (: (Operation (List Analysis)) (loop [membersT+ (type.flatten-tuple expectedT) @@ -187,7 +187,7 @@ (def: #export (product analyse membersC) (-> Phase (List Code) (Operation Analysis)) - (do ///.Monad<Operation> + (do ///.monad [expectedT (extension.lift macro.expected-type)] (///.with-stack cannot-analyse-tuple [expectedT membersC] (case expectedT @@ -254,7 +254,7 @@ (def: #export (tagged-sum analyse tag valueC) (-> Phase Name Code (Operation Analysis)) - (do ///.Monad<Operation> + (do ///.monad [tag (extension.lift (macro.normalize tag)) [idx group variantT] (extension.lift (macro.resolve-tag tag)) expectedT (extension.lift macro.expected-type)] @@ -279,11 +279,11 @@ ## canonical form (with their corresponding module identified). (def: #export (normalize record) (-> (List [Code Code]) (Operation (List [Name Code]))) - (monad.map ///.Monad<Operation> + (monad.map ///.monad (function (_ [key val]) (case key [_ (#.Tag key)] - (do ///.Monad<Operation> + (do ///.monad [key (extension.lift (macro.normalize key))] (wrap [key val])) @@ -299,10 +299,10 @@ (case record ## empty-record = empty-tuple = unit = [] #.Nil - (:: ///.Monad<Operation> wrap [(list) Any]) + (:: ///.monad wrap [(list) Any]) (#.Cons [head-k head-v] _) - (do ///.Monad<Operation> + (do ///.monad [head-k (extension.lift (macro.normalize head-k)) [_ tag-set recordT] (extension.lift (macro.resolve-tag head-k)) #let [size-record (list.size record) @@ -311,7 +311,7 @@ (wrap []) (///.throw record-size-mismatch [size-ts size-record recordT record])) #let [tuple-range (list.indices size-ts) - tag->idx (dict.from-list name.Hash<Name> (list.zip2 tag-set tuple-range))] + tag->idx (dict.from-list name.hash (list.zip2 tag-set tuple-range))] idx->val (monad.fold @ (function (_ [key val] idx->val) (do @ @@ -325,7 +325,7 @@ #.None (///.throw tag-does-not-belong-to-record [key recordT])))) (: (Dictionary Nat Code) - (dict.new number.Hash<Nat>)) + (dict.new number.hash)) record) #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val))) tuple-range)]] @@ -334,7 +334,7 @@ (def: #export (record analyse members) (-> Phase (List [Code Code]) (Operation Analysis)) - (do ///.Monad<Operation> + (do ///.monad [members (normalize members) [membersC recordT] (order members)] (case membersC diff --git a/stdlib/source/lux/platform/compiler/phase/analysis/type.lux b/stdlib/source/lux/platform/compiler/phase/analysis/type.lux index c3219f5ac..75d691628 100644 --- a/stdlib/source/lux/platform/compiler/phase/analysis/type.lux +++ b/stdlib/source/lux/platform/compiler/phase/analysis/type.lux @@ -35,14 +35,14 @@ (def: #export (infer actualT) (-> Type (Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [expectedT (extension.lift macro.expected-type)] (with-env (tc.check expectedT actualT)))) (def: #export (with-inference action) (All [a] (-> (Operation a) (Operation [Type a]))) - (do ///.Monad<Operation> + (do ///.monad [[_ varT] (..with-env tc.var) output (with-type varT diff --git a/stdlib/source/lux/platform/compiler/phase/extension.lux b/stdlib/source/lux/platform/compiler/phase/extension.lux index ec7323b1e..4e5721c5e 100644 --- a/stdlib/source/lux/platform/compiler/phase/extension.lux +++ b/stdlib/source/lux/platform/compiler/phase/extension.lux @@ -5,10 +5,10 @@ ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] - ["." text ("text/." Order<Text>) + ["." text ("text/." order) format] [collection - ["." list ("list/." Functor<List>)] + ["." list ("list/." functor)] ["." dictionary (#+ Dictionary)]]] ["." function]] ["." //]) diff --git a/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux index 73f0d6c9d..426c8af9e 100644 --- a/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/platform/compiler/phase/extension/analysis/common.lux @@ -6,7 +6,7 @@ ["." text format] [collection - ["." list ("list/." Functor<List>)] + ["." list ("list/." functor)] ["." dictionary (#+ Dictionary)]]] [type ["." check]] @@ -30,7 +30,7 @@ (function (_ extension-name analyse args) (let [num-actual (list.size args)] (if (n/= num-expected num-actual) - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer outputT) argsA (monad.map @ (function (_ [argT argC]) @@ -61,7 +61,7 @@ (def: lux::is Handler (function (_ extension-name analyse args) - (do ////.Monad<Operation> + (do ////.monad [[var-id varT] (typeA.with-env check.var)] ((binary varT varT Bit extension-name) analyse args)))) @@ -73,7 +73,7 @@ (function (_ extension-name analyse args) (case args (^ (list opC)) - (do ////.Monad<Operation> + (do ////.monad [[var-id varT] (typeA.with-env check.var) _ (typeA.infer (type (Either Text varT))) opA (typeA.with-type (type (IO varT)) @@ -100,7 +100,7 @@ (function (_ extension-name analyse args) (case args (^ (list typeC valueC)) - (do ////.Monad<Operation> + (do ////.monad [count (///.lift macro.count) actualT (:: @ map (|>> (:coerce Type)) (eval count Type typeC)) @@ -120,7 +120,7 @@ (function (_ extension-name analyse args) (case args (^ (list valueC)) - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer Type) valueA (typeA.with-type Type (analyse valueC))] diff --git a/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux index 2981dc89b..6b4b7ad36 100644 --- a/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/extension/analysis/host.jvm.lux @@ -9,10 +9,10 @@ ["." error (#+ Error)] ["." maybe] ["." product] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format] [collection - ["." list ("list/." Fold<List> Functor<List> Monoid<List>)] + ["." list ("list/." fold functor monoid)] ["." array (#+ Array)] ["." dictionary (#+ Dictionary)]]] ["." type @@ -24,7 +24,7 @@ ["." common] ["/." // ["." bundle] - ["//." // ("operation/." Monad<Operation>) + ["//." // ("operation/." monad) ["." analysis (#+ Analysis Operation Handler Bundle) [".A" type] [".A" inference]]]]] @@ -216,14 +216,14 @@ ["float" "java.lang.Float"] ["double" "java.lang.Double"] ["char" "java.lang.Character"]) - (dictionary.from-list text.Hash<Text>))) + (dictionary.from-list text.hash))) (def: array::length Handler (function (_ extension-name analyse args) (case args (^ (list arrayC)) - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer Nat) [var-id varT] (typeA.with-env check.var) arrayA (typeA.with-type (type (Array varT)) @@ -238,7 +238,7 @@ (function (_ extension-name analyse args) (case args (^ (list lengthC)) - (do ////.Monad<Operation> + (do ////.monad [lengthA (typeA.with-type Nat (analyse lengthC)) expectedT (///.lift macro.expected-type) @@ -303,7 +303,7 @@ (def: (check-object objectT) (-> Type (Operation Text)) - (do ////.Monad<Operation> + (do ////.monad [name (check-jvm objectT)] (if (dictionary.contains? name boxes) (////.throw primitives-are-not-objects name) @@ -331,7 +331,7 @@ (function (_ extension-name analyse args) (case args (^ (list arrayC idxC)) - (do ////.Monad<Operation> + (do ////.monad [[var-id varT] (typeA.with-env check.var) _ (typeA.infer varT) arrayA (typeA.with-type (type (Array varT)) @@ -351,7 +351,7 @@ (function (_ extension-name analyse args) (case args (^ (list arrayC idxC valueC)) - (do ////.Monad<Operation> + (do ////.monad [[var-id varT] (typeA.with-env check.var) _ (typeA.infer (type (Array varT))) arrayA (typeA.with-type (type (Array varT)) @@ -383,7 +383,7 @@ (function (_ extension-name analyse args) (case args (^ (list)) - (do ////.Monad<Operation> + (do ////.monad [expectedT (///.lift macro.expected-type) _ (check-object expectedT)] (wrap (#analysis.Extension extension-name (list)))) @@ -396,7 +396,7 @@ (function (_ extension-name analyse args) (case args (^ (list objectC)) - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer Bit) [objectT objectA] (typeA.with-inference (analyse objectC)) @@ -411,7 +411,7 @@ (function (_ extension-name analyse args) (case args (^ (list monitorC exprC)) - (do ////.Monad<Operation> + (do ////.monad [[monitorT monitorA] (typeA.with-inference (analyse monitorC)) _ (check-object monitorT) @@ -482,7 +482,7 @@ (def: (load-class name) (-> Text (Operation (Class Object))) - (do ////.Monad<Operation> + (do ////.monad [] (case (Class::forName name) (#error.Success [class]) @@ -493,7 +493,7 @@ (def: (sub-class? super sub) (-> Text Text (Operation Bit)) - (do ////.Monad<Operation> + (do ////.monad [super (load-class super) sub (load-class sub)] (wrap (Class::isAssignableFrom sub super)))) @@ -503,7 +503,7 @@ (function (_ extension-name analyse args) (case args (^ (list exceptionC)) - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer Nothing) [exceptionT exceptionA] (typeA.with-inference (analyse exceptionC)) @@ -525,7 +525,7 @@ (^ (list classC)) (case classC [_ (#.Text class)] - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) _ (load-class class)] (wrap (#analysis.Extension extension-name (list (analysis.text class))))) @@ -543,7 +543,7 @@ (^ (list classC objectC)) (case classC [_ (#.Text class)] - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer Bit) [objectT objectA] (typeA.with-inference (analyse objectC)) @@ -573,7 +573,7 @@ (type: Mappings (Dictionary Text Type)) -(def: fresh-mappings Mappings (dictionary.new text.Hash<Text>)) +(def: fresh-mappings Mappings (dictionary.new text.hash)) (def: (java-type-to-lux-type mappings java-type) (-> Mappings java/lang/reflect/Type (Operation Type)) @@ -614,7 +614,7 @@ (let [java-type (:coerce ParameterizedType java-type) raw (ParameterizedType::getRawType java-type)] (if (host.instance? Class raw) - (do ////.Monad<Operation> + (do ////.monad [paramsT (|> java-type ParameterizedType::getActualTypeArguments array.to-list @@ -624,7 +624,7 @@ (////.throw jvm-type-is-not-a-class raw))) (host.instance? GenericArrayType java-type) - (do ////.Monad<Operation> + (do ////.monad [innerT (|> (:coerce GenericArrayType java-type) GenericArrayType::getGenericComponentType (java-type-to-lux-type mappings))] @@ -656,7 +656,7 @@ ## else (operation/wrap (|> params (list.zip2 (list/map (|>> TypeVariable::getName) class-params)) - (dictionary.from-list text.Hash<Text>))) + (dictionary.from-list text.hash))) )) _ @@ -667,7 +667,7 @@ (function (_ extension-name analyse args) (case args (^ (list valueC)) - (do ////.Monad<Operation> + (do ////.monad [toT (///.lift macro.expected-type) to-name (check-jvm toT) [valueT valueA] (typeA.with-inference @@ -756,7 +756,7 @@ (def: (find-field class-name field-name) (-> Text Text (Operation [(Class Object) Field])) - (do ////.Monad<Operation> + (do ////.monad [class (load-class class-name)] (case (Class::getDeclaredField field-name class) (#error.Success field) @@ -773,7 +773,7 @@ (def: (static-field class-name field-name) (-> Text Text (Operation [Type Bit])) - (do ////.Monad<Operation> + (do ////.monad [[class fieldJ] (find-field class-name field-name) #let [modifiers (Field::getModifiers fieldJ)]] (if (Modifier::isStatic modifiers) @@ -785,7 +785,7 @@ (def: (virtual-field class-name field-name objectT) (-> Text Text Type (Operation [Type Bit])) - (do ////.Monad<Operation> + (do ////.monad [[class fieldJ] (find-field class-name field-name) #let [modifiers (Field::getModifiers fieldJ)]] (if (not (Modifier::isStatic modifiers)) @@ -808,7 +808,7 @@ " Type: " (%type objectT)) (n/= num-params num-vars))] (wrap (|> (list.zip2 var-names _class-params) - (dictionary.from-list text.Hash<Text>)))) + (dictionary.from-list text.hash)))) _ (////.throw non-object objectT))) @@ -823,7 +823,7 @@ (^ (list classC fieldC)) (case [classC fieldC] [[_ (#.Text class)] [_ (#.Text field)]] - (do ////.Monad<Operation> + (do ////.monad [[fieldT final?] (static-field class field)] (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field))))) @@ -840,7 +840,7 @@ (^ (list classC fieldC valueC)) (case [classC fieldC] [[_ (#.Text class)] [_ (#.Text field)]] - (do ////.Monad<Operation> + (do ////.monad [_ (typeA.infer Any) [fieldT final?] (static-field class field) _ (////.assert cannot-set-a-final-field (format class "#" field) @@ -862,7 +862,7 @@ (^ (list classC fieldC objectC)) (case [classC fieldC] [[_ (#.Text class)] [_ (#.Text field)]] - (do ////.Monad<Operation> + (do ////.monad [[objectT objectA] (typeA.with-inference (analyse objectC)) [fieldT final?] (virtual-field class field objectT)] @@ -881,7 +881,7 @@ (^ (list classC fieldC valueC objectC)) (case [classC fieldC] [[_ (#.Text class)] [_ (#.Text field)]] - (do ////.Monad<Operation> + (do ////.monad [[objectT objectA] (typeA.with-inference (analyse objectC)) _ (typeA.infer objectT) @@ -911,7 +911,7 @@ (operation/wrap "java.lang.Object") (host.instance? GenericArrayType type) - (do ////.Monad<Operation> + (do ////.monad [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType (:coerce GenericArrayType type)))] (wrap (format componentP "[]"))) @@ -927,7 +927,7 @@ (def: (check-method class method-name method-style arg-classes method) (-> (Class Object) Text Method-Style (List Text) Method (Operation Bit)) - (do ////.Monad<Operation> + (do ////.monad [parameters (|> (Method::getGenericParameterTypes method) array.to-list (monad.map @ java-type-to-parameter)) @@ -956,7 +956,7 @@ (def: (check-constructor class arg-classes constructor) (-> (Class Object) (List Text) (Constructor Object) (Operation Bit)) - (do ////.Monad<Operation> + (do ////.monad [parameters (|> (Constructor::getGenericParameterTypes constructor) array.to-list (monad.map @ java-type-to-parameter))] @@ -1006,8 +1006,8 @@ (|> (list/compose owner-tvarsT method-tvarsT) list.reverse (list.zip2 all-tvars) - (dictionary.from-list text.Hash<Text>))))] - (do ////.Monad<Operation> + (dictionary.from-list text.hash))))] + (do ////.monad [inputsT (|> (Method::getGenericParameterTypes method) array.to-list (monad.map @ (java-type-to-lux-type mappings))) @@ -1046,7 +1046,7 @@ (def: (method-candidate class-name method-name method-style arg-classes) (-> Text Text Method-Style (List Text) (Operation Method-Signature)) - (do ////.Monad<Operation> + (do ////.monad [class (load-class class-name) candidates (|> class Class::getDeclaredMethods @@ -1094,8 +1094,8 @@ (|> (list/compose owner-tvarsT constructor-tvarsT) list.reverse (list.zip2 all-tvars) - (dictionary.from-list text.Hash<Text>))))] - (do ////.Monad<Operation> + (dictionary.from-list text.hash))))] + (do ////.monad [inputsT (|> (Constructor::getGenericParameterTypes constructor) array.to-list (monad.map @ (java-type-to-lux-type mappings))) @@ -1112,7 +1112,7 @@ (def: (constructor-candidate class-name arg-classes) (-> Text (List Text) (Operation Method-Signature)) - (do ////.Monad<Operation> + (do ////.monad [class (load-class class-name) candidates (|> class Class::getConstructors @@ -1146,7 +1146,7 @@ (case (: (Error [Text Text (List [Text Code])]) (s.run args ($_ p.and s.text s.text (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class method argsTC]) - (do ////.Monad<Operation> + (do ////.monad [#let [argsT (list/map product.left argsTC)] [methodT exceptionsT] (method-candidate class method #Static argsT) [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC)) @@ -1163,7 +1163,7 @@ (case (: (Error [Text Text Code (List [Text Code])]) (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class method objectC argsTC]) - (do ////.Monad<Operation> + (do ////.monad [#let [argsT (list/map product.left argsTC)] [methodT exceptionsT] (method-candidate class method #Virtual argsT) [outputT allA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) @@ -1186,7 +1186,7 @@ (case (: (Error [(List Code) [Text Text Code (List [Text Code]) Any]]) (p.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))) s.end!))) (#error.Success [_ [class method objectC argsTC _]]) - (do ////.Monad<Operation> + (do ////.monad [#let [argsT (list/map product.left argsTC)] [methodT exceptionsT] (method-candidate class method #Special argsT) [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) @@ -1203,7 +1203,7 @@ (case (: (Error [Text Text Code (List [Text Code])]) (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class-name method objectC argsTC]) - (do ////.Monad<Operation> + (do ////.monad [#let [argsT (list/map product.left argsTC)] class (load-class class-name) _ (////.assert non-interface class-name @@ -1224,7 +1224,7 @@ (case (: (Error [Text (List [Text Code])]) (s.run args ($_ p.and s.text (p.some (s.tuple (p.and s.text s.any)))))) (#error.Success [class argsTC]) - (do ////.Monad<Operation> + (do ////.monad [#let [argsT (list/map product.left argsTC)] [methodT exceptionsT] (constructor-candidate class argsT) [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))] diff --git a/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux b/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux index 582526694..41879fa0c 100644 --- a/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux +++ b/stdlib/source/lux/platform/compiler/phase/extension/bundle.lux @@ -6,13 +6,13 @@ ["." text format] [collection - [list ("list/." Functor<List>)] + [list ("list/." functor)] ["." dictionary (#+ Dictionary)]]]] [// (#+ Handler Bundle)]) (def: #export empty Bundle - (dictionary.new text.Hash<Text>)) + (dictionary.new text.hash)) (def: #export (install name anonymous) (All [s i o] @@ -25,4 +25,4 @@ (-> Text (-> (Bundle s i o) (Bundle s i o)))) (|>> dictionary.entries (list/map (function (_ [key val]) [(format prefix " " key) val])) - (dictionary.from-list text.Hash<Text>))) + (dictionary.from-list text.hash))) diff --git a/stdlib/source/lux/platform/compiler/phase/extension/statement.lux b/stdlib/source/lux/platform/compiler/phase/extension/statement.lux index e5963e96c..02edd7565 100644 --- a/stdlib/source/lux/platform/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/platform/compiler/phase/extension/statement.lux @@ -7,7 +7,7 @@ [text format] [collection - [list ("list/." Functor<List>)] + [list ("list/." functor)] ["." dictionary]]] ["." macro] [type (#+ :share) @@ -25,7 +25,7 @@ (def: (evaluate! type codeC) (All [anchor expression statement] (-> Type Code (Operation anchor expression statement [Type expression Any]))) - (do ///.Monad<Operation> + (do ///.monad [state (//.lift ///.get-state) #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) @@ -51,7 +51,7 @@ (All [anchor expression statement] (-> Name (Maybe Type) Code (Operation anchor expression statement [Type expression Text Any]))) - (do ///.Monad<Operation> + (do ///.monad [state (//.lift ///.get-state) #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) @@ -86,7 +86,7 @@ (function (_ extension-name phase inputsC+) (case inputsC+ (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC)) - (do ///.Monad<Operation> + (do ///.monad [current-module (statement.lift-analysis (//.lift macro.current-module-name)) #let [full-name [current-module short-name]] @@ -117,7 +117,7 @@ (def: (alias! alias def-name) (-> Text Name (analysis.Operation Any)) - (do ///.Monad<Operation> + (do ///.monad [definition (//.lift (macro.find-def def-name))] (module.define alias definition))) @@ -126,7 +126,7 @@ (function (_ extension-name phase inputsC+) (case inputsC+ (^ (list annotationsC)) - (do ///.Monad<Operation> + (do ///.monad [[_ annotationsT annotationsV] (evaluate! Code annotationsC) _ (statement.lift-analysis (module.set-annotations (:coerce Code annotationsV)))] @@ -155,7 +155,7 @@ (function (handler extension-name phase inputsC+) (case inputsC+ (^ (list [_ (#.Text name)] valueC)) - (do ///.Monad<Operation> + (do ///.monad [[_ handlerT handlerV] (evaluate! (:of (:share [anchor expression statement] {(Handler anchor expression statement) handler} diff --git a/stdlib/source/lux/platform/compiler/phase/statement/total.lux b/stdlib/source/lux/platform/compiler/phase/statement/total.lux index 15f116aa1..c494b01c6 100644 --- a/stdlib/source/lux/platform/compiler/phase/statement/total.lux +++ b/stdlib/source/lux/platform/compiler/phase/statement/total.lux @@ -31,7 +31,7 @@ (extension.apply "Statement" phase [name inputs]) (^ [_ (#.Form (list& macro inputs))]) - (do ///.Monad<Operation> + (do ///.monad [expansion (//.lift-analysis (do @ [macroA (type.with-type Macro diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis.lux b/stdlib/source/lux/platform/compiler/phase/synthesis.lux index cf29ad74b..f1239fdfe 100644 --- a/stdlib/source/lux/platform/compiler/phase/synthesis.lux +++ b/stdlib/source/lux/platform/compiler/phase/synthesis.lux @@ -5,11 +5,11 @@ [equivalence (#+ Equivalence)] ["ex" exception (#+ exception:)]] [data - [bit ("bit/." Equivalence<Bit>)] - ["." text ("text/." Equivalence<Text>) + [bit ("bit/." equivalence)] + ["." text ("text/." equivalence) format] [collection - [list ("list/." Functor<List>)] + [list ("list/." functor)] ["." dictionary (#+ Dictionary)]]]] ["." // ["." analysis (#+ Environment Arity Composite Analysis)] @@ -24,7 +24,7 @@ (def: #export fresh-resolver Resolver - (dictionary.new reference.Hash<Variable>)) + (dictionary.new reference.hash)) (def: #export init State @@ -192,7 +192,7 @@ (def: #export with-new-local (All [a] (-> (Operation a) (Operation a))) - (<<| (do //.Monad<Operation> + (<<| (do //.monad [locals ..locals]) (..with-locals (inc locals)))) @@ -388,7 +388,7 @@ (Format Path) (%path' %synthesis)) -(structure: #export _ (Equivalence Primitive) +(structure: #export primitive-equivalence (Equivalence Primitive) (def: (= reference sample) (case [reference sample] (^template [<tag> <eq> <format>] @@ -404,7 +404,7 @@ _ false))) -(structure: #export _ (Equivalence Access) +(structure: #export access-equivalence (Equivalence Access) (def: (= reference sample) (case [reference sample] (^template [<tag>] @@ -424,7 +424,7 @@ _ false))) -(structure: #export (Equivalence<Path'> Equivalence<a>) +(structure: #export (path'-equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Path' a)))) (def: (= reference sample) @@ -435,8 +435,8 @@ (^template [<tag> <equivalence>] [(<tag> reference') (<tag> sample')] (:: <equivalence> = reference' sample')) - ([#Test Equivalence<Primitive>] - [#Access Equivalence<Access>] + ([#Test primitive-equivalence] + [#Access access-equivalence] [#Then Equivalence<a>]) [(#Bind reference') (#Bind sample')] @@ -452,17 +452,17 @@ _ false))) -(structure: #export _ (Equivalence Synthesis) +(structure: #export equivalence (Equivalence Synthesis) (def: (= reference sample) (case [reference sample] (^template [<tag> <equivalence>] [(<tag> reference') (<tag> sample')] (:: <equivalence> = reference' sample')) - ([#Primitive Equivalence<Primitive>]) + ([#Primitive primitive-equivalence]) _ false))) -(def: #export Equivalence<Path> +(def: #export path-equivalence (Equivalence Path) - (Equivalence<Path'> Equivalence<Synthesis>)) + (path'-equivalence equivalence)) diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux index e9e941a30..95adf33f3 100644 --- a/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux +++ b/stdlib/source/lux/platform/compiler/phase/synthesis/case.lux @@ -6,15 +6,15 @@ ["." monad (#+ do)]] [data ["." product] - [bit ("bit/." Equivalence<Bit>)] - [text ("text/." Equivalence<Text>) + [bit ("bit/." equivalence)] + [text ("text/." equivalence) format] - [number ("frac/." Equivalence<Frac>)] + [number ("frac/." equivalence)] [collection - ["." list ("list/." Fold<List> Monoid<List>)]]]] + ["." list ("list/." fold monoid)]]]] ["." // (#+ Path Synthesis Operation Phase) ["." function] - ["/." // ("operation/." Monad<Operation>) + ["/." // ("operation/." monad) ["." analysis (#+ Pattern Match Analysis)] [// ["." reference]]]]) @@ -43,7 +43,7 @@ [#analysis.Text #//.Text])) (#analysis.Bind register) - (<| (:: ///.Monad<Operation> map (|>> (#//.Seq (#//.Bind register)))) + (<| (:: ///.monad map (|>> (#//.Seq (#//.Bind register)))) //.with-new-local thenC) @@ -121,7 +121,7 @@ (def: #export (synthesize synthesize^ inputA [headB tailB+]) (-> Phase Analysis Match (Operation Synthesis)) - (do ///.Monad<Operation> + (do ///.monad [inputS (synthesize^ inputA)] (with-expansions [<unnecesary-let> (as-is (^multi (^ (#analysis.Reference (reference.local outputR))) diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux index 672bc9e87..7b836b29a 100644 --- a/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux +++ b/stdlib/source/lux/platform/compiler/phase/synthesis/expression.lux @@ -7,12 +7,12 @@ ["." maybe] ["." error] [collection - ["." list ("list/." Functor<List>)] + ["." list ("list/." functor)] ["." dictionary (#+ Dictionary)]]]] ["." // (#+ Synthesis Phase) ["." function] ["." case] - ["/." // ("operation/." Monad<Operation>) + ["/." // ("operation/." monad) ["." analysis (#+ Analysis)] ["." extension] [// @@ -47,14 +47,14 @@ (#analysis.Structure structure) (case structure (#analysis.Variant variant) - (do ///.Monad<Operation> + (do ///.monad [valueS (phase (get@ #analysis.value variant))] (wrap (//.variant (set@ #analysis.value valueS variant)))) (#analysis.Tuple tuple) (|> tuple - (monad.map ///.Monad<Operation> phase) - (:: ///.Monad<Operation> map (|>> //.tuple)))) + (monad.map ///.monad phase) + (:: ///.monad map (|>> //.tuple)))) (#analysis.Reference reference) (operation/wrap (#//.Reference reference)) @@ -80,7 +80,7 @@ (#error.Failure error) (<| (///.run' state) - (do ///.Monad<Operation> + (do ///.monad [argsS+ (monad.map @ phase args)] (wrap (#//.Extension [name argsS+]))))))) )) diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux index 267d941fc..ccc7835a4 100644 --- a/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux +++ b/stdlib/source/lux/platform/compiler/phase/synthesis/function.lux @@ -8,11 +8,11 @@ ["." text format] [collection - ["." list ("list/." Functor<List> Monoid<List> Fold<List>)] + ["." list ("list/." functor monoid fold)] ["dict" dictionary (#+ Dictionary)]]]] ["." // (#+ Path Synthesis Operation Phase) ["." loop (#+ Transform)] - ["/." // ("operation/." Monad<Operation>) + ["/." // ("operation/." monad) ["." analysis (#+ Environment Arity Analysis)] [// ["." reference (#+ Register Variable)]]]]) @@ -40,7 +40,7 @@ (-> Phase Phase) (function (_ exprA) (let [[funcA argsA] (analysis.application exprA)] - (do ///.Monad<Operation> + (do ///.monad [funcS (phase funcA) argsS (monad.map @ phase argsA) ## locals //.locals @@ -75,7 +75,7 @@ (^template [<tag>] (<tag> left right) - (do ///.Monad<Operation> + (do ///.monad [left' (grow-path grow left) right' (grow-path grow right)] (wrap (<tag> left' right')))) @@ -91,7 +91,7 @@ (def: (grow-sub-environment super sub) (-> Environment Environment (Operation Environment)) - (monad.map ///.Monad<Operation> + (monad.map ///.monad (function (_ variable) (case variable (#reference.Local register) @@ -113,7 +113,7 @@ (#analysis.Tuple membersS+) (|> membersS+ - (monad.map ///.Monad<Operation> (grow environment)) + (monad.map ///.monad (grow environment)) (operation/map (|>> //.tuple)))) (^ (..self-reference)) @@ -139,20 +139,20 @@ (#//.Branch branch) (case branch (#//.Let [inputS register bodyS]) - (do ///.Monad<Operation> + (do ///.monad [inputS' (grow environment inputS) bodyS' (grow environment bodyS)] (wrap (//.branch/let [inputS' (inc register) bodyS']))) (#//.If [testS thenS elseS]) - (do ///.Monad<Operation> + (do ///.monad [testS' (grow environment testS) thenS' (grow environment thenS) elseS' (grow environment elseS)] (wrap (//.branch/if [testS' thenS' elseS']))) (#//.Case [inputS pathS]) - (do ///.Monad<Operation> + (do ///.monad [inputS' (grow environment inputS) pathS' (grow-path (grow environment) pathS)] (wrap (//.branch/case [inputS' pathS'])))) @@ -160,20 +160,20 @@ (#//.Loop loop) (case loop (#//.Scope [start initsS+ iterationS]) - (do ///.Monad<Operation> + (do ///.monad [initsS+' (monad.map @ (grow environment) initsS+) iterationS' (grow environment iterationS)] (wrap (//.loop/scope [start initsS+' iterationS']))) (#//.Recur argumentsS+) (|> argumentsS+ - (monad.map ///.Monad<Operation> (grow environment)) + (monad.map ///.monad (grow environment)) (operation/map (|>> //.loop/recur)))) (#//.Function function) (case function (#//.Abstraction [_env _arity _body]) - (do ///.Monad<Operation> + (do ///.monad [_env' (grow-sub-environment environment _env)] (wrap (//.function/abstraction [_env' _arity _body]))) @@ -184,14 +184,14 @@ (list/compose pre-argsS+ argsS+)])) _ - (do ///.Monad<Operation> + (do ///.monad [funcS' (grow environment funcS) argsS+' (monad.map @ (grow environment) argsS+)] (wrap (//.function/apply [funcS' argsS+'])))))) (#//.Extension name argumentsS+) (|> argumentsS+ - (monad.map ///.Monad<Operation> (grow environment)) + (monad.map ///.monad (grow environment)) (operation/map (|>> (#//.Extension name)))) _ @@ -199,7 +199,7 @@ (def: #export (abstraction phase environment bodyA) (-> Phase Environment Analysis (Operation Synthesis)) - (do ///.Monad<Operation> + (do ///.monad [bodyS (phase bodyA)] (case bodyS (^ (//.function/abstraction [env' down-arity' bodyS'])) diff --git a/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux index cd57c1d29..924a9b413 100644 --- a/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux +++ b/stdlib/source/lux/platform/compiler/phase/synthesis/loop.lux @@ -4,9 +4,9 @@ ["." monad (#+ do)] ["p" parser]] [data - ["." maybe ("maybe/." Monad<Maybe>)] + ["." maybe ("maybe/." monad)] [collection - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] [macro ["." code] ["." syntax]]] @@ -179,7 +179,7 @@ (^template [<tag>] (<tag> leftS rightS) - (do maybe.Monad<Maybe> + (do maybe.monad [leftS' (recur leftS) rightS' (recur rightS)] (wrap (<tag> leftS' rightS')))) @@ -198,7 +198,7 @@ (#//.Structure structureS) (case structureS (#analysis.Variant variantS) - (do maybe.Monad<Maybe> + (do maybe.monad [valueS' (|> variantS (get@ #analysis.value) recur)] (wrap (|> variantS (set@ #analysis.value valueS') @@ -207,7 +207,7 @@ (#analysis.Tuple membersS+) (|> membersS+ - (monad.map maybe.Monad<Maybe> recur) + (monad.map maybe.monad recur) (maybe/map (|>> #analysis.Tuple #//.Structure)))) (#//.Reference reference) @@ -224,29 +224,29 @@ (maybe/map (|>> #reference.Variable #//.Reference)))) (^ (//.branch/case [inputS pathS])) - (do maybe.Monad<Maybe> + (do maybe.monad [inputS' (recur inputS) pathS' (adjust-path recur offset pathS)] (wrap (|> pathS' [inputS'] //.branch/case))) (^ (//.branch/let [inputS register bodyS])) - (do maybe.Monad<Maybe> + (do maybe.monad [inputS' (recur inputS) bodyS' (recur bodyS)] (wrap (//.branch/let [inputS' register bodyS']))) (^ (//.branch/if [inputS thenS elseS])) - (do maybe.Monad<Maybe> + (do maybe.monad [inputS' (recur inputS) thenS' (recur thenS) elseS' (recur elseS)] (wrap (//.branch/if [inputS' thenS' elseS']))) (^ (//.loop/scope scopeS)) - (do maybe.Monad<Maybe> + (do maybe.monad [inits' (|> scopeS (get@ #//.inits) - (monad.map maybe.Monad<Maybe> recur)) + (monad.map maybe.monad recur)) iteration' (recur (get@ #//.iteration scopeS))] (wrap (//.loop/scope {#//.start (|> scopeS (get@ #//.start) (n/+ offset)) #//.inits inits' @@ -254,26 +254,26 @@ (^ (//.loop/recur argsS)) (|> argsS - (monad.map maybe.Monad<Maybe> recur) + (monad.map maybe.monad recur) (maybe/map (|>> //.loop/recur))) (^ (//.function/abstraction [environment arity bodyS])) - (do maybe.Monad<Maybe> - [environment' (monad.map maybe.Monad<Maybe> + (do maybe.monad + [environment' (monad.map maybe.monad (resolve scope-environment) environment)] (wrap (//.function/abstraction [environment' arity bodyS]))) (^ (//.function/apply [function arguments])) - (do maybe.Monad<Maybe> + (do maybe.monad [function' (recur function) - arguments' (monad.map maybe.Monad<Maybe> recur arguments)] + arguments' (monad.map maybe.monad recur arguments)] (wrap (//.function/apply [function' arguments']))) (#//.Extension [name argsS]) (|> argsS - (monad.map maybe.Monad<Maybe> recur) + (monad.map maybe.monad recur) (maybe/map (|>> [name] #//.Extension))) _ diff --git a/stdlib/source/lux/platform/compiler/phase/translation.lux b/stdlib/source/lux/platform/compiler/phase/translation.lux index c7fb60c08..79c343d5a 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation.lux @@ -6,7 +6,7 @@ [data ["." product] ["." error (#+ Error)] - ["." name ("name/." Equivalence<Name>)] + ["." name ("name/." equivalence)] ["." text format] [collection @@ -92,9 +92,9 @@ #anchor #.None #host host #buffer #.None - #outputs (dictionary.new text.Hash<Text>) + #outputs (dictionary.new text.hash) #counter 0 - #name-cache (dictionary.new name.Hash<Name>)}) + #name-cache (dictionary.new name.hash)}) (def: #export (with-context expr) (All [anchor expression statement output] @@ -166,7 +166,7 @@ (def: #export next (All [anchor expression statement] (Operation anchor expression statement Nat)) - (do //.Monad<Operation> + (do //.monad [count (extension.read (get@ #counter)) _ (extension.update (update@ #counter inc))] (wrap count))) @@ -201,7 +201,7 @@ (def: #export (save! name code) (All [anchor expression statement] (-> Name statement (Operation anchor expression statement Any))) - (do //.Monad<Operation> + (do //.monad [count ..next _ (execute! (format "save" (%n count)) code) ?buffer (extension.read (get@ #buffer))] @@ -217,7 +217,7 @@ (def: #export (save-buffer! target) (All [anchor expression statement] (-> File (Operation anchor expression statement Any))) - (do //.Monad<Operation> + (do //.monad [buffer ..buffer] (extension.update (update@ #outputs (dictionary.put target buffer))))) diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux index 4a963d507..b50e4485a 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/case.jvm.lux @@ -8,12 +8,12 @@ ["." text format] [collection - [list ("list/." Functor<List> Fold<List>)] + [list ("list/." functor fold)] [set (#+ Set)]]]] [// ["." runtime (#+ Operation Phase)] ["." reference] - ["/." /// ("operation/." Monad<Operation>) + ["/." /// ("operation/." monad) ["." synthesis (#+ Synthesis Path)] [// [reference (#+ Register)] @@ -24,7 +24,7 @@ (def: #export (let translate [valueS register bodyS]) (-> Phase [Synthesis Register Synthesis] (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [valueO (translate valueS) bodyO (translate bodyS)] (wrap (_.let (list [(reference.local' register) valueO]) @@ -33,7 +33,7 @@ (def: #export (record-get translate valueS pathP) (-> Phase Synthesis (List [Nat Bit]) (Operation Expression)) - (do ////.Monad<Operation> + (do ////.monad [valueO (translate valueS)] (wrap (list/fold (function (_ [idx tail?] source) (.let [method (.if tail? @@ -46,7 +46,7 @@ (def: #export (if translate [testS thenS elseS]) (-> Phase [Synthesis Synthesis Synthesis] (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [testO (translate testS) thenO (translate thenS) elseO (translate elseS)] @@ -143,7 +143,7 @@ (^template [<tag> <computation>] (^ (<tag> leftP rightP)) - (do ////.Monad<Operation> + (do ////.monad [leftO (pattern-matching' translate leftP) rightO (pattern-matching' translate rightP)] (wrap <computation>))) @@ -161,7 +161,7 @@ (def: (pattern-matching translate pathP) (-> Phase Path (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [pattern-matching! (pattern-matching' translate pathP)] (wrap (_.with-exception-handler (pm-catch (_.raise/1 (_.string "Invalid expression for pattern-matching."))) @@ -170,7 +170,7 @@ (def: #export (case translate [valueS pathP]) (-> Phase [Synthesis Path] (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [valueO (translate valueS)] (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))] [@savepoint (_.list/* (list))]))) diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux index a503949dd..46f0c8102 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/extension/common.jvm.lux @@ -10,7 +10,7 @@ format] [number (#+ hex)] [collection - ["." list ("list/." Functor<List>)] + ["." list ("list/." functor)] ["dict" dictionary (#+ Dictionary)]]] ["." macro (#+ with-gensyms) ["." code] @@ -26,7 +26,6 @@ [host ["_" scheme (#+ Expression Computation)]]]]]) -## [Types] (syntax: (Vector {size s.nat} elemT) (wrap (list (` [(~+ (list.repeat size elemT))])))) @@ -36,7 +35,6 @@ (type: #export Trinary (-> (Vector 3 Expression) Computation)) (type: #export Variadic (-> (List Expression) Computation)) -## [Utils] (syntax: (arity: {name s.local-identifier} {arity s.nat}) (with-gensyms [g!_ g!extension g!name g!phase g!inputs] (do @ @@ -47,7 +45,7 @@ (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) - (do /////.Monad<Operation> + (do /////.monad [(~+ (|> g!input+ (list/map (function (_ g!input) (list g!input (` ((~ g!phase) (~ g!input)))))) @@ -66,19 +64,16 @@ (-> Variadic Handler) (function (_ extension-name) (function (_ phase inputsS) - (do /////.Monad<Operation> + (do /////.monad [inputsI (monad.map @ phase inputsS)] (wrap (extension inputsI)))))) -## [Bundle] -## [[Lux]] (def: bundle::lux Bundle (|> bundle.empty (bundle.install "is?" (binary (product.uncurry _.eq?/2))) (bundle.install "try" (unary runtime.lux//try)))) -## [[Bits]] (do-template [<name> <op>] [(def: (<name> [subjectO paramO]) Binary @@ -115,7 +110,6 @@ (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift)) ))) -## [[Numbers]] (import: java/lang/Double (#static MIN_VALUE Double) (#static MAX_VALUE Double)) @@ -202,7 +196,6 @@ (bundle.install "encode" (unary _.number->string/1)) (bundle.install "decode" (unary runtime.frac//decode))))) -## [[Text]] (def: (text::char [subjectO paramO]) Binary (_.string/1 (_.string-ref/2 subjectO paramO))) @@ -222,7 +215,6 @@ (bundle.install "char" (binary text::char)) (bundle.install "clip" (trinary text::clip))))) -## [[IO]] (def: (io::log input) Unary (_.begin (list (_.display/1 input) @@ -241,7 +233,6 @@ (bundle.install "exit" (unary _.exit/1)) (bundle.install "current-time" (nullary (function (_ _) (runtime.io//current-time (_.string synthesis.unit)))))))) -## [Bundles] (def: #export bundle Bundle (<| (bundle.prefix "lux") diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux index 7eeb5a8ed..8d19558dd 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/function.jvm.lux @@ -8,12 +8,12 @@ [text format] [collection - ["." list ("list/." Functor<List>)]]]] + ["." list ("list/." functor)]]]] [// ["." runtime (#+ Operation Phase)] ["." reference] ["/." // - ["//." // ("operation/." Monad<Operation>) + ["//." // ("operation/." monad) [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] [synthesis (#+ Synthesis)] [// @@ -25,7 +25,7 @@ (def: #export (apply translate [functionS argsS+]) (-> Phase (Application Synthesis) (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [functionO (translate functionS) argsO+ (monad.map @ translate argsS+)] (wrap (_.apply/* functionO argsO+)))) @@ -54,7 +54,7 @@ (def: #export (function translate [environment arity bodyS]) (-> Phase (Abstraction Synthesis) (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [[function-name bodyO] (///.with-context (do @ [function-name ///.context] diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux index 91757d291..e25b96254 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/loop.jvm.lux @@ -7,7 +7,7 @@ ["." text format] [collection - ["." list ("list/." Functor<List>)]]]] + ["." list ("list/." functor)]]]] [// [runtime (#+ Operation Phase)] ["." reference] @@ -22,7 +22,7 @@ (def: #export (scope translate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [initsO+ (monad.map @ translate initsS+) bodyO (///.with-anchor @scope (translate bodyS))] @@ -35,7 +35,7 @@ (def: #export (recur translate argsS+) (-> Phase (List Synthesis) (Operation Computation)) - (do ////.Monad<Operation> + (do ////.monad [@scope ///.anchor argsO+ (monad.map @ translate argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux index c16c696c4..caa71f74f 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/primitive.jvm.lux @@ -3,7 +3,7 @@ [// [runtime (#+ Operation)] [// (#+ State) - [// ("operation/." Monad<Operation>) + [// ("operation/." monad) [/// [host ["_" scheme (#+ Expression)]]]]]]) diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux index 6d4088189..88e091e83 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/reference.jvm.lux @@ -8,7 +8,7 @@ [// [runtime (#+ Operation)] ["/." // - [// ("operation/." Monad<Operation>) + [// ("operation/." monad) [analysis (#+ Variant Tuple)] [synthesis (#+ Synthesis)] [// diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux index 43748c3b1..97e53d143 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/runtime.jvm.lux @@ -1,14 +1,14 @@ (.module: [lux #* [control - ["p" parser ("parser/." Monad<Parser>)] + ["p" parser ("parser/." monad)] [monad (#+ do)]] [data [number (#+ hex)] [text format] [collection - ["." list ("list/." Monad<List>)]]] + ["." list ("list/." monad)]]] ["." function] [macro ["." code] @@ -138,16 +138,16 @@ (with-vars [error] (_.with-exception-handler (_.lambda [(list error) #.None] - (..left error)) + (..left error)) (_.lambda [(list) #.None] - (..right (_.apply/* op (list ..unit))))))) + (..right (_.apply/* op (list ..unit))))))) (runtime: (lux//program-args program-args) (with-vars [@loop @input @output] (_.letrec (list [@loop (_.lambda [(list @input @output) #.None] - (_.if (_.eqv?/2 _.nil @input) - @output - (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))]) + (_.if (_.eqv?/2 _.nil @input) + @output + (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))]) (_.apply/2 @loop (_.reverse/1 program-args) ..none)))) (def: runtime//lux @@ -317,6 +317,6 @@ (def: #export translate (Operation Any) (///.with-buffer - (do ////.Monad<Operation> + (do ////.monad [_ (///.save! ["" ..prefix] ..runtime)] (///.save-buffer! "")))) diff --git a/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux b/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux index 3991ea281..dc1b88591 100644 --- a/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux +++ b/stdlib/source/lux/platform/compiler/phase/translation/scheme/structure.jvm.lux @@ -22,12 +22,12 @@ (translate singletonS) _ - (do ///.Monad<Operation> + (do ///.monad [elemsT+ (monad.map @ translate elemsS+)] (wrap (_.vector/* elemsT+))))) (def: #export (variant translate [lefts right? valueS]) (-> Phase (Variant Synthesis) (Operation Expression)) - (do ///.Monad<Operation> + (do ///.monad [valueT (translate valueS)] (wrap (runtime.variant [lefts right? valueT])))) diff --git a/stdlib/source/lux/platform/compiler/reference.lux b/stdlib/source/lux/platform/compiler/reference.lux index b945c1327..a20691986 100644 --- a/stdlib/source/lux/platform/compiler/reference.lux +++ b/stdlib/source/lux/platform/compiler/reference.lux @@ -18,7 +18,7 @@ (#Variable Variable) (#Constant Name)) -(structure: #export _ (Equivalence Variable) +(structure: #export equivalence (Equivalence Variable) (def: (= reference sample) (case [reference sample] (^template [<tag>] @@ -29,8 +29,8 @@ _ #0))) -(structure: #export _ (Hash Variable) - (def: eq Equivalence<Variable>) +(structure: #export hash (Hash Variable) + (def: &equivalence ..equivalence) (def: (hash var) (case var (#Local register) diff --git a/stdlib/source/lux/platform/interpreter.lux b/stdlib/source/lux/platform/interpreter.lux index a75cbc01e..87206750d 100644 --- a/stdlib/source/lux/platform/interpreter.lux +++ b/stdlib/source/lux/platform/interpreter.lux @@ -5,7 +5,7 @@ ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format]] [type (#+ :share) ["." check]] @@ -56,7 +56,7 @@ (All [anchor expression statement] (Operation anchor expression statement Any)) (statement.lift-analysis - (do phase.Monad<Operation> + (do phase.monad [_ (module.create 0 ..module)] (analysis.set-current-module ..module)))) @@ -87,7 +87,7 @@ (def: (interpret-statement code) (All [anchor expression statement] (-> Code <Interpretation>)) - (do phase.Monad<Operation> + (do phase.monad [_ (total.phase code) _ init.refresh] (wrap [Any []]))) @@ -95,7 +95,7 @@ (def: (interpret-expression code) (All [anchor expression statement] (-> Code <Interpretation>)) - (do phase.Monad<Operation> + (do phase.monad [state (extension.lift phase.get-state) #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) @@ -146,7 +146,7 @@ (def: (execute configuration code) (All [anchor expression statement] (-> Configuration Code (Operation anchor expression statement Text))) - (do phase.Monad<Operation> + (do phase.monad [[codeT codeV] (interpret configuration code) state phase.get-state] (wrap (/type.represent (get@ [#extension.state @@ -165,7 +165,7 @@ (def: (read-eval-print context) (All [anchor expression statement] (-> <Context> (Error [<Context> Text]))) - (do error.Monad<Error> + (do error.monad [#let [[_where _offset _code] (get@ #source context)] [source' input] (syntax.parse ..module syntax.no-aliases (text.size _code) (get@ #source context)) [state' representation] (let [## TODO: Simplify ASAP diff --git a/stdlib/source/lux/platform/interpreter/type.lux b/stdlib/source/lux/platform/interpreter/type.lux index 698238e1c..f6a66a76a 100644 --- a/stdlib/source/lux/platform/interpreter/type.lux +++ b/stdlib/source/lux/platform/interpreter/type.lux @@ -32,12 +32,12 @@ (def: primitive-representation (Poly Representation) (`` ($_ p.either - (do p.Monad<Parser> + (do p.monad [_ (poly.exactly Any)] (wrap (function.constant "[]"))) (~~ (do-template [<type> <formatter>] - [(do p.Monad<Parser> + [(do p.monad [_ (poly.sub <type>)] (wrap (|>> (:coerce <type>) <formatter>)))] @@ -52,7 +52,7 @@ (-> (Poly Representation) (Poly Representation)) (`` ($_ p.either (~~ (do-template [<type> <formatter>] - [(do p.Monad<Parser> + [(do p.monad [_ (poly.sub <type>)] (wrap (|>> (:coerce <type>) <formatter>)))] @@ -64,12 +64,12 @@ [JSON %json] [XML %xml])) - (do p.Monad<Parser> + (do p.monad [[_ elemT] (poly.apply (p.and (poly.exactly List) poly.any)) elemR (poly.local (list elemT) representation)] (wrap (|>> (:coerce (List Any)) (%list elemR)))) - (do p.Monad<Parser> + (do p.monad [[_ elemT] (poly.apply (p.and (poly.exactly Maybe) poly.any)) elemR (poly.local (list elemT) representation)] (wrap (|>> (:coerce (Maybe Any)) @@ -81,7 +81,7 @@ (def: (record-representation tags representation) (-> (List Name) (Poly Representation) (Poly Representation)) - (do p.Monad<Parser> + (do p.monad [membersR+ (poly.tuple (p.many representation)) _ (p.assert "Number of tags does not match record type size." (n/= (list.size tags) (list.size membersR+)))] @@ -103,7 +103,7 @@ (def: (variant-representation tags representation) (-> (List Name) (Poly Representation) (Poly Representation)) - (do p.Monad<Parser> + (do p.monad [casesR+ (poly.variant (p.many representation)) #let [num-tags (list.size tags)] _ (p.assert "Number of tags does not match variant type size." @@ -131,7 +131,7 @@ (def: (tagged-representation compiler representation) (-> Lux (Poly Representation) (Poly Representation)) - (do p.Monad<Parser> + (do p.monad [[name anonymous] poly.named] (case (macro.run compiler (macro.tags-of name)) (#error.Success ?tags) @@ -149,7 +149,7 @@ (def: (tuple-representation representation) (-> (Poly Representation) (Poly Representation)) - (do p.Monad<Parser> + (do p.monad [membersR+ (poly.tuple (p.many representation))] (wrap (function (_ tupleV) (let [tuple-body (loop [representations membersR+ @@ -176,7 +176,7 @@ (tagged-representation compiler representation) (tuple-representation representation) - (do p.Monad<Parser> + (do p.monad [[funcT inputsT+] (poly.apply (p.and poly.any (p.many poly.any)))] (case (type.apply inputsT+ funcT) (#.Some outputT) @@ -185,7 +185,7 @@ #.None (p.fail ""))) - (do p.Monad<Parser> + (do p.monad [[name anonymous] poly.named] (poly.local (list anonymous) representation)) diff --git a/stdlib/source/lux/platform/mediator.lux b/stdlib/source/lux/platform/mediator.lux new file mode 100644 index 000000000..4481b6e2e --- /dev/null +++ b/stdlib/source/lux/platform/mediator.lux @@ -0,0 +1,20 @@ +(.module: + [lux (#- Source Module) + [data + ["." error (#+ Error)]] + [world + ["." binary (#+ Binary)] + ["." file (#+ File)]]] + [// + [compiler (#+ Compiler) + [meta + ["." archive (#+ Archive) + [descriptor (#+ Module)]]]]]) + +(type: #export Source File) + +(type: #export (Mediator !) + (-> Archive Module (! Archive))) + +(type: #export (Instancer ! d o) + (-> (file.System !) (List Source) (Compiler d o) (Mediator !))) diff --git a/stdlib/source/lux/platform/mediator/parallelism.lux b/stdlib/source/lux/platform/mediator/parallelism.lux new file mode 100644 index 000000000..251ec1f9f --- /dev/null +++ b/stdlib/source/lux/platform/mediator/parallelism.lux @@ -0,0 +1,169 @@ +(.module: + [lux (#- Source Module) + [control + ["." monad (#+ Monad do)] + ["ex" exception (#+ exception:)]] + [concurrency + ["." promise (#+ Promise) ("promise/." functor)] + ["." task (#+ Task)] + ["." stm (#+ Var STM)]] + [data + ["." error (#+ Error) ("error/." monad)] + ["." text ("text/." equivalence) + format] + [collection + [list ("list/." functor)] + ["." dictionary (#+ Dictionary)]]] + ["." io]] + ["." // (#+ Source Mediator) + [// + ["." compiler (#+ Input Output Compilation Compiler) + [meta + ["." archive (#+ Archive) + ["." descriptor (#+ Module Descriptor)] + [document (#+ Document)]] + [io + ["." context]]]]]]) + +(exception: #export (self-dependency {module Module}) + (ex.report ["Module" module])) + +(exception: #export (circular-dependency {module Module} {dependency Module}) + (ex.report ["Module" module] + ["Dependency" dependency])) + +(type: Pending-Compilation + (Promise (Error (Ex [d] (Document d))))) + +(type: Active-Compilations + (Dictionary Module [Descriptor Pending-Compilation])) + +(def: (self-dependence? module dependency) + (-> Module Module Bit) + (text/= module dependency)) + +(def: (circular-dependence? active dependency) + (-> Active-Compilations Module Bit) + (case (dictionary.get dependency active) + (#.Some [descriptor pending]) + (case (get@ #descriptor.state descriptor) + #.Active + true + + _ + false) + + #.None + false)) + +(def: (ensure-valid-dependencies! active dependencies module) + (-> Active-Compilations (List Module) Module (Task Any)) + (do task.monad + [_ (: (Task Any) + (if (list.any? (self-dependence? module) dependencies) + (task.throw self-dependency module) + (wrap [])))] + (: (Task Any) + (case (list.find (circular-dependence? active) dependencies) + (#.Some dependency) + (task.throw circular-dependency module dependency) + + #.None + (wrap []))))) + +(def: (share-compilation archive pending) + (-> Active-Compilations Pending-Compilation (Task Archive)) + (promise/map (|>> (error/map (function (_ document) + (archive.add module document archive))) + error/join) + pending)) + +(def: (import Monad<!> mediate archive dependencies) + (All [!] (-> (Monad !) (Mediator !) Active-Compilations (List Module) (! (List Archive)))) + (|> dependencies + (list/map (mediate archive)) + (monad.seq Monad<!>))) + +(def: (step-compilation archive imports [dependencies process]) + (All [d o] (-> Archive (List Archive) (Compilation d o) + [Archive (Either (Compilation d o) + [(Document d) (Output o)])])) + (do error.monad + [archive' (monad.fold error.monad archive.merge archive imports) + outcome (process archive')] + (case outcome + (#.Right [document output]) + (do @ + [archive'' (archive.add module document archive')] + (wrap [archive'' (#.Right [document output])])) + + (#.Left continue) + (wrap [archive' outcome])))) + +(def: (request-compilation file-system sources module compilations) + (All [!] + (-> (file.System Task) (List Source) Module (Var Active-Compilations) + (Task (Either Pending-Compilation + [Pending-Compilation Active-Compilations Input])))) + (do (:: file-system &monad) + [current (|> (stm.read compilations) + stm.commit + task.from-promise)] + (case (dictionary.get module current) + (#.Some [descriptor pending]) + (wrap (#.Left pending)) + + #.None + (do @ + [input (context.read file-system sources module)] + (do stm.monad + [stale (stm.read compilations)] + (case (dictionary.get module stale) + (#.Some [descriptor pending]) + (wrap (#.Left [pending current])) + + #.None + (do @ + [#let [base-descriptor {#descriptor.hash (get@ #compiler.hash input) + #descriptor.name (get@ #compiler.module input) + #descriptor.file (get@ #compiler.file input) + #descriptor.references (list) + #descriptor.state #.Active} + pending (promise.promise (: (Maybe (Error (Ex [d] (Document d)))) + #.None))] + updated (stm.update (dictionary.put (get@ #compiler.module input) + [base-descriptor pending]) + compilations)] + (wrap (is? current stale) + (#.Right [pending updated input]))))))))) + +(def: (mediate-compilation Monad<!> mediate compiler input archive pending) + (All [! d o] (-> (Monad !) (Mediator ! d o) (Compiler d o) Input Archive Pending-Compilation (Task Archive))) + (loop [archive archive + compilation (compiler input)] + (do Monad<!> + [#let [[dependencies process] compilation] + _ (ensure-valid-dependencies! active dependencies (get@ #compiler.module input)) + imports (import @ mediate archive dependencies) + [archive' next] (promise/wrap (step-compilation archive imports compilation))] + (case next + (#.Left continue) + (recur archive' continue) + + (#.Right [document output]) + (exec (io.run (promise.resolve (#error.Success document) pending)) + (wrap archive')))))) + +(def: #export (mediator file-system sources compiler) + (//.Instancer Task) + (let [compilations (: (Var Active-Compilations) + (stm.var (dictionary.new text.hash)))] + (function (mediate archive module) + (do (:: file-system &monad) + [request (request-compilation file-system sources module compilations)] + (case request + (#.Left pending) + (share-compilation archive pending) + + (#.Right [pending active input]) + (mediate-compilation @ mediate compiler input archive pending)))))) |