diff options
Diffstat (limited to '')
30 files changed, 724 insertions, 700 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux index 65a66e65a..87a930b7a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -11,9 +11,9 @@ ["." list ("#/." functor monoid)]]] [tool [compiler + [analysis (#+ Arity)] ["_." reference (#+ Register Variable)] ["." phase - [analysis (#+ Arity)] [synthesis (#+ Synthesis Abstraction Apply)] ["." translation]]]]] [luxc diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 81bae4cd2..0dbef1563 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -10,8 +10,8 @@ ["." math] [tool [compiler + [analysis (#+ Arity)] ["." phase - [analysis (#+ Arity)] ["." translation]]]]] [luxc [lang diff --git a/stdlib/source/lux/tool/compiler/analysis.lux b/stdlib/source/lux/tool/compiler/analysis.lux new file mode 100644 index 000000000..b13b5aefc --- /dev/null +++ b/stdlib/source/lux/tool/compiler/analysis.lux @@ -0,0 +1,349 @@ +(.module: + [lux (#- nat int rev) + [control + [monad (#+ do)]] + [data + ["." product] + ["." error] + ["." maybe] + ["." text ("#/." equivalence) + format] + [collection + ["." list ("#/." functor fold)]]] + ["." function]] + [// + ["." reference (#+ Register Variable Reference)] + [phase + ["." extension (#+ Extension)]]]) + +(type: #export #rec Primitive + #Unit + (#Bit Bit) + (#Nat Nat) + (#Int Int) + (#Rev Rev) + (#Frac Frac) + (#Text Text)) + +(type: #export Tag Nat) + +(type: #export (Variant a) + {#lefts Nat + #right? Bit + #value a}) + +(type: #export (Tuple a) (List a)) + +(type: #export (Composite a) + (#Variant (Variant a)) + (#Tuple (Tuple a))) + +(type: #export #rec Pattern + (#Simple Primitive) + (#Complex (Composite Pattern)) + (#Bind Register)) + +(type: #export (Branch' e) + {#when Pattern + #then e}) + +(type: #export (Match' e) + [(Branch' e) (List (Branch' e))]) + +(type: #export Environment + (List Variable)) + +(type: #export #rec Analysis + (#Primitive Primitive) + (#Structure (Composite Analysis)) + (#Reference Reference) + (#Case Analysis (Match' Analysis)) + (#Function Environment Analysis) + (#Apply Analysis Analysis) + (#Extension (Extension Analysis))) + +(type: #export Branch + (Branch' Analysis)) + +(type: #export Match + (Match' Analysis)) + +(do-template [<name> <tag>] + [(template: #export (<name> content) + (<tag> content))] + + [control/case #..Case] + ) + +(do-template [<name> <type> <tag>] + [(def: #export <name> + (-> <type> Analysis) + (|>> <tag> #..Primitive))] + + [bit Bit #..Bit] + [nat Nat #..Nat] + [int Int #..Int] + [rev Rev #..Rev] + [frac Frac #..Frac] + [text Text #..Text] + ) + +(type: #export Arity Nat) + +(type: #export (Abstraction c) [Environment Arity c]) + +(type: #export (Application c) [c (List c)]) + +(def: (last? size tag) + (-> Nat Tag Bit) + (n/= (dec size) tag)) + +(template: #export (no-op value) + (|> 1 #reference.Local #reference.Variable #..Reference + (#..Function (list)) + (#..Apply value))) + +(def: #export (apply [abstraction inputs]) + (-> (Application Analysis) Analysis) + (list/fold (function (_ input abstraction') + (#Apply input abstraction')) + abstraction + inputs)) + +(def: #export (application analysis) + (-> Analysis (Application Analysis)) + (loop [abstraction analysis + inputs (list)] + (case abstraction + (#Apply input next) + (recur next (#.Cons input inputs)) + + _ + [abstraction inputs]))) + +(do-template [<name> <tag>] + [(template: #export (<name> content) + (.<| #..Reference + <tag> + content))] + + [variable #reference.Variable] + [constant #reference.Constant] + ) + +(do-template [<name> <tag>] + [(template: #export (<name> content) + (.<| #..Complex + <tag> + content))] + + [pattern/variant #..Variant] + [pattern/tuple #..Tuple] + ) + +(do-template [<name> <tag>] + [(template: #export (<name> content) + (.<| #..Structure + <tag> + content))] + + [variant #..Variant] + [tuple #..Tuple] + ) + +(template: #export (pattern/unit) + (#..Simple #..Unit)) + +(do-template [<name> <tag>] + [(template: #export (<name> content) + (#..Simple (<tag> content)))] + + [pattern/bit #..Bit] + [pattern/nat #..Nat] + [pattern/int #..Int] + [pattern/rev #..Rev] + [pattern/frac #..Frac] + [pattern/text #..Text] + ) + +(template: #export (pattern/bind register) + (#..Bind register)) + +(def: #export (%analysis analysis) + (Format Analysis) + (case analysis + (#Primitive primitive) + (case primitive + #Unit + "[]" + + (^template [<tag> <format>] + (<tag> value) + (<format> value)) + ([#Bit %b] + [#Nat %n] + [#Int %i] + [#Rev %r] + [#Frac %f] + [#Text %t])) + + (#Structure structure) + (case structure + (#Variant [lefts right? value]) + (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")") + + (#Tuple members) + (|> members + (list/map %analysis) + (text.join-with " ") + (text.enclose ["[" "]"]))) + + (#Reference reference) + (case reference + (#reference.Variable variable) + (reference.%variable variable) + + (#reference.Constant constant) + (%name constant)) + + (#Case analysis match) + "{?}" + + (#Function environment body) + (|> (%analysis body) + (format " ") + (format (|> environment + (list/map reference.%variable) + (text.join-with " ") + (text.enclose ["[" "]"]))) + (text.enclose ["(" ")"])) + + (#Apply _) + (|> analysis + ..application + #.Cons + (list/map %analysis) + (text.join-with " ") + (text.enclose ["(" ")"])) + + (#Extension name parameters) + (|> parameters + (list/map %analysis) + (text.join-with " ") + (format (%t name) " ") + (text.enclose ["(" ")"])))) + +(do-template [<special> <general>] + [(type: #export <special> + (<general> .Lux Code Analysis))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) + +(def: #export (with-source-code source action) + (All [a] (-> Source (Operation a) (Operation a))) + (function (_ [bundle state]) + (let [old-source (get@ #.source state)] + (case (action [bundle (set@ #.source source state)]) + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' (set@ #.source old-source state')] + output]) + + (#error.Failure error) + (#error.Failure error))))) + +(def: fresh-bindings + (All [k v] (Bindings k v)) + {#.counter 0 + #.mappings (list)}) + +(def: fresh-scope + Scope + {#.name (list) + #.inner 0 + #.locals fresh-bindings + #.captured fresh-bindings}) + +(def: #export (with-scope action) + (All [a] (-> (Operation a) (Operation [Scope a]))) + (function (_ [bundle state]) + (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)]) + (#error.Success [[bundle' state'] output]) + (case (get@ #.scopes state') + (#.Cons head tail) + (#error.Success [[bundle' (set@ #.scopes tail state')] + [head output]]) + + #.Nil + (#error.Failure "Impossible error: Drained scopes!")) + + (#error.Failure error) + (#error.Failure error)))) + +(def: #export (with-current-module name) + (All [a] (-> Text (Operation a) (Operation a))) + (extension.localized (get@ #.current-module) + (set@ #.current-module) + (function.constant (#.Some name)))) + +(def: #export (with-cursor cursor action) + (All [a] (-> Cursor (Operation a) (Operation a))) + (if (text/= "" (product.left cursor)) + action + (function (_ [bundle state]) + (let [old-cursor (get@ #.cursor state)] + (case (action [bundle (set@ #.cursor cursor state)]) + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' (set@ #.cursor old-cursor state')] + output]) + + (#error.Failure error) + (#error.Failure (format "@ " (%cursor cursor) text.new-line + error))))))) + +(do-template [<name> <type> <field> <value>] + [(def: #export (<name> value) + (-> <type> (Operation Any)) + (extension.update (set@ <field> <value>)))] + + [set-source-code Source #.source value] + [set-current-module Text #.current-module (#.Some value)] + [set-cursor Cursor #.cursor value] + ) + +(def: #export (cursor file) + (-> Text Cursor) + [file 1 0]) + +(def: #export (source file code) + (-> Text Text Source) + [(cursor file) 0 code]) + +(def: dummy-source + Source + [.dummy-cursor 0 ""]) + +(def: type-context + Type-Context + {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)}) + +(def: #export (state info host) + (-> Info Any Lux) + {#.info info + #.source ..dummy-source + #.cursor .dummy-cursor + #.current-module #.None + #.modules (list) + #.scopes (list) + #.type-context ..type-context + #.expected #.None + #.seed 0 + #.scope-type-vars (list) + #.extensions [] + #.host host}) diff --git a/stdlib/source/lux/tool/compiler/default/evaluation.lux b/stdlib/source/lux/tool/compiler/default/evaluation.lux index 68fda1e7d..98da861d7 100644 --- a/stdlib/source/lux/tool/compiler/default/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/default/evaluation.lux @@ -8,13 +8,14 @@ format]]] [/// ["." phase - [analysis (#+ Operation) - [".A" expression] + ["." analysis ["." type] [macro (#+ Expander)]] ["." synthesis [".S" expression]] - ["." translation]]]) + ["." translation] + [// + [analysis (#+ Operation)]]]]) (type: #export Eval (-> Nat Type Code (Operation Any))) @@ -26,7 +27,7 @@ (translation.State+ anchor expression statement) (translation.Phase anchor expression statement) Eval)) - (let [analyze (expressionA.phase expander)] + (let [analyze (analysis.phase expander)] (function (eval count type exprC) (do phase.monad [exprA (type.with-type type diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 8d23b6a4a..465112327 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -17,12 +17,12 @@ ["." syntax (#+ Aliases)] ["." evaluation] ["/." // (#+ Instancer) + ["." analysis] ["." host] ["." phase - ["." analysis + [".P" analysis ["." module] - [macro (#+ Expander)] - [".A" expression]] + [macro (#+ Expander)]] ["." synthesis [".S" expression]] ["." translation] @@ -82,7 +82,7 @@ analysis-state [(analysisE.bundle eval) (analysis.state ..info host)]] [statementE.bundle {#statement.analysis {#statement.state analysis-state - #statement.phase (expressionA.phase expander)} + #statement.phase (analysisP.phase expander)} #statement.synthesis {#statement.state synthesis-state #statement.phase expressionS.phase} #statement.translation {#statement.state translation-state diff --git a/stdlib/source/lux/tool/compiler/phase/analysis.lux b/stdlib/source/lux/tool/compiler/phase/analysis.lux index 845346482..e9fd18a9d 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis.lux @@ -1,349 +1,131 @@ (.module: - [lux (#- nat int rev) + [lux #* [control - [monad (#+ do)]] + [monad (#+ do)] + ["ex" exception (#+ exception:)]] [data - ["." product] ["." error] - ["." maybe] - ["." text ("#/." equivalence) - format] - [collection - ["." list ("#/." functor fold)]]] - ["." function]] - [// - ["." extension (#+ Extension)] - [// - ["." reference (#+ Register Variable Reference)]]]) - -(type: #export #rec Primitive - #Unit - (#Bit Bit) - (#Nat Nat) - (#Int Int) - (#Rev Rev) - (#Frac Frac) - (#Text Text)) - -(type: #export Tag Nat) - -(type: #export (Variant a) - {#lefts Nat - #right? Bit - #value a}) - -(type: #export (Tuple a) (List a)) - -(type: #export (Composite a) - (#Variant (Variant a)) - (#Tuple (Tuple a))) - -(type: #export #rec Pattern - (#Simple Primitive) - (#Complex (Composite Pattern)) - (#Bind Register)) - -(type: #export (Branch' e) - {#when Pattern - #then e}) - -(type: #export (Match' e) - [(Branch' e) (List (Branch' e))]) - -(type: #export Environment - (List Variable)) - -(type: #export #rec Analysis - (#Primitive Primitive) - (#Structure (Composite Analysis)) - (#Reference Reference) - (#Case Analysis (Match' Analysis)) - (#Function Environment Analysis) - (#Apply Analysis Analysis) - (#Extension (Extension Analysis))) - -(type: #export Branch - (Branch' Analysis)) - -(type: #export Match - (Match' Analysis)) - -(do-template [<name> <tag>] - [(template: #export (<name> content) - (<tag> content))] - - [control/case #..Case] - ) - -(do-template [<name> <type> <tag>] - [(def: #export <name> - (-> <type> Analysis) - (|>> <tag> #..Primitive))] - - [bit Bit #..Bit] - [nat Nat #..Nat] - [int Int #..Int] - [rev Rev #..Rev] - [frac Frac #..Frac] - [text Text #..Text] - ) - -(type: #export Arity Nat) - -(type: #export (Abstraction c) [Environment Arity c]) - -(type: #export (Application c) [c (List c)]) - -(def: (last? size tag) - (-> Nat Tag Bit) - (n/= (dec size) tag)) - -(template: #export (no-op value) - (|> 1 #reference.Local #reference.Variable #..Reference - (#..Function (list)) - (#..Apply value))) - -(def: #export (apply [abstraction inputs]) - (-> (Application Analysis) Analysis) - (list/fold (function (_ input abstraction') - (#Apply input abstraction')) - abstraction - inputs)) - -(def: #export (application analysis) - (-> Analysis (Application Analysis)) - (loop [abstraction analysis - inputs (list)] - (case abstraction - (#Apply input next) - (recur next (#.Cons input inputs)) - - _ - [abstraction inputs]))) - -(do-template [<name> <tag>] - [(template: #export (<name> content) - (.<| #..Reference - <tag> - content))] - - [variable #reference.Variable] - [constant #reference.Constant] - ) - -(do-template [<name> <tag>] - [(template: #export (<name> content) - (.<| #..Complex - <tag> - content))] - - [pattern/variant #..Variant] - [pattern/tuple #..Tuple] - ) - -(do-template [<name> <tag>] - [(template: #export (<name> content) - (.<| #..Structure - <tag> - content))] - - [variant #..Variant] - [tuple #..Tuple] - ) - -(template: #export (pattern/unit) - (#..Simple #..Unit)) - -(do-template [<name> <tag>] - [(template: #export (<name> content) - (#..Simple (<tag> content)))] - - [pattern/bit #..Bit] - [pattern/nat #..Nat] - [pattern/int #..Int] - [pattern/rev #..Rev] - [pattern/frac #..Frac] - [pattern/text #..Text] - ) - -(template: #export (pattern/bind register) - (#..Bind register)) - -(def: #export (%analysis analysis) - (Format Analysis) - (case analysis - (#Primitive primitive) - (case primitive - #Unit - "[]" - - (^template [<tag> <format>] - (<tag> value) - (<format> value)) - ([#Bit %b] - [#Nat %n] - [#Int %i] - [#Rev %r] - [#Frac %f] - [#Text %t])) - - (#Structure structure) - (case structure - (#Variant [lefts right? value]) - (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")") - - (#Tuple members) - (|> members - (list/map %analysis) - (text.join-with " ") - (text.enclose ["[" "]"]))) - - (#Reference reference) - (case reference - (#reference.Variable variable) - (reference.%variable variable) - - (#reference.Constant constant) - (%name constant)) - - (#Case analysis match) - "{?}" - - (#Function environment body) - (|> (%analysis body) - (format " ") - (format (|> environment - (list/map reference.%variable) - (text.join-with " ") - (text.enclose ["[" "]"]))) - (text.enclose ["(" ")"])) - - (#Apply _) - (|> analysis - ..application - #.Cons - (list/map %analysis) - (text.join-with " ") - (text.enclose ["(" ")"])) - - (#Extension name parameters) - (|> parameters - (list/map %analysis) - (text.join-with " ") - (format (%t name) " ") - (text.enclose ["(" ")"])))) - -(do-template [<special> <general>] - [(type: #export <special> - (<general> .Lux Code Analysis))] - - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] - [Handler extension.Handler] - [Bundle extension.Bundle] - ) - -(def: #export (with-source-code source action) - (All [a] (-> Source (Operation a) (Operation a))) - (function (_ [bundle state]) - (let [old-source (get@ #.source state)] - (case (action [bundle (set@ #.source source state)]) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' (set@ #.source old-source state')] - output]) - - (#error.Failure error) - (#error.Failure error))))) - -(def: fresh-bindings - (All [k v] (Bindings k v)) - {#.counter 0 - #.mappings (list)}) - -(def: fresh-scope - Scope - {#.name (list) - #.inner 0 - #.locals fresh-bindings - #.captured fresh-bindings}) - -(def: #export (with-scope action) - (All [a] (-> (Operation a) (Operation [Scope a]))) - (function (_ [bundle state]) - (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)]) - (#error.Success [[bundle' state'] output]) - (case (get@ #.scopes state') - (#.Cons head tail) - (#error.Success [[bundle' (set@ #.scopes tail state')] - [head output]]) - - #.Nil - (#error.Failure "Impossible error: Drained scopes!")) - - (#error.Failure error) - (#error.Failure error)))) - -(def: #export (with-current-module name) - (All [a] (-> Text (Operation a) (Operation a))) - (extension.localized (get@ #.current-module) - (set@ #.current-module) - (function.constant (#.Some name)))) - -(def: #export (with-cursor cursor action) - (All [a] (-> Cursor (Operation a) (Operation a))) - (if (text/= "" (product.left cursor)) - action - (function (_ [bundle state]) - (let [old-cursor (get@ #.cursor state)] - (case (action [bundle (set@ #.cursor cursor state)]) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' (set@ #.cursor old-cursor state')] - output]) - - (#error.Failure error) - (#error.Failure (format "@ " (%cursor cursor) text.new-line - error))))))) - -(do-template [<name> <type> <field> <value>] - [(def: #export (<name> value) - (-> <type> (Operation Any)) - (extension.update (set@ <field> <value>)))] - - [set-source-code Source #.source value] - [set-current-module Text #.current-module (#.Some value)] - [set-cursor Cursor #.cursor value] - ) - -(def: #export (cursor file) - (-> Text Cursor) - [file 1 0]) - -(def: #export (source file code) - (-> Text Text Source) - [(cursor file) 0 code]) - -(def: dummy-source - Source - [.dummy-cursor 0 ""]) - -(def: type-context - Type-Context - {#.ex-counter 0 - #.var-counter 0 - #.var-bindings (list)}) - -(def: #export (state info host) - (-> Info Any Lux) - {#.info info - #.source ..dummy-source - #.cursor .dummy-cursor - #.current-module #.None - #.modules (list) - #.scopes (list) - #.type-context ..type-context - #.expected #.None - #.seed 0 - #.scope-type-vars (list) - #.extensions [] - #.host host}) + [text + format]] + ["." macro]] + [/ + ["/." type] + ["/." primitive] + ["/." structure] + ["/." reference] + ["/." case] + ["/." function] + ["/." macro (#+ Expander)] + ["." // + ["." extension] + [// + ["." reference] + ["/" analysis (#+ Analysis Operation Phase)]]]]) + +(exception: #export (unrecognized-syntax {code Code}) + (ex.report ["Code" (%code code)])) + +## TODO: Had to split the 'compile' function due to compilation issues +## with old-luxc. Must re-combine all the code ASAP + +(type: (Fix a) + (-> a a)) + +(def: (compile|primitive else code') + (Fix (-> (Code' (Ann Cursor)) (Operation Analysis))) + (case code' + (^template [<tag> <analyser>] + (<tag> value) + (<analyser> value)) + ([#.Bit /primitive.bit] + [#.Nat /primitive.nat] + [#.Int /primitive.int] + [#.Rev /primitive.rev] + [#.Frac /primitive.frac] + [#.Text /primitive.text]) + + _ + (else code'))) + +(def: (compile|structure compile else code') + (-> Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))) + (case code' + (^template [<tag> <analyser>] + (^ (#.Form (list& [_ (<tag> tag)] + values))) + (case values + (#.Cons value #.Nil) + (<analyser> compile tag value) + + _ + (<analyser> compile tag (` [(~+ values)])))) + ([#.Nat /structure.sum] + [#.Tag /structure.tagged-sum]) + + (#.Tag tag) + (/structure.tagged-sum compile tag (' [])) + + (^ (#.Tuple (list))) + /primitive.unit + + (^ (#.Tuple (list singleton))) + (compile singleton) + + (^ (#.Tuple elems)) + (/structure.product compile elems) + + (^ (#.Record pairs)) + (/structure.record compile pairs) + + _ + (else code'))) + +(def: (compile|others expander compile code') + (-> Expander Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) + (case code' + (#.Identifier reference) + (/reference.reference reference) + + (^ (#.Form (list [_ (#.Record branches)] input))) + (/case.case compile input branches) + + (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) + (extension.apply compile [extension-name extension-args]) + + (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] + [_ (#.Identifier ["" arg-name])]))] + body))) + (/function.function compile function-name arg-name body) + + (^ (#.Form (list& functionC argsC+))) + (do //.monad + [[functionT functionA] (/type.with-inference + (compile functionC))] + (case functionA + (#/.Reference (#reference.Constant def-name)) + (do @ + [?macro (extension.lift (macro.find-macro def-name))] + (case ?macro + (#.Some macro) + (do @ + [expansion (extension.lift (/macro.expand-one expander def-name macro argsC+))] + (compile expansion)) + + _ + (/function.apply compile functionT functionA argsC+))) + + _ + (/function.apply compile functionT functionA argsC+))) + + _ + (//.throw unrecognized-syntax [.dummy-cursor code']))) + +(def: #export (phase expander) + (-> Expander Phase) + (function (compile code) + (let [[cursor code'] code] + ## The cursor must be set in the state for the sake + ## of having useful error messages. + (/.with-cursor cursor + (compile|primitive (compile|structure compile (compile|others expander compile)) + code'))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux index 37bcfef6e..688d04c95 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux @@ -15,14 +15,16 @@ ["." check]] ["." macro ["." code]]] - ["." // (#+ Pattern Analysis Operation Phase) - ["." scope] + [// + ["//." scope] ["//." type] - ["." structure] + ["//." structure] ["/." // - ["." extension]]] + ["///." extension] + [// + ["/" analysis (#+ Pattern Analysis Operation Phase)]]]] [/ - ["." coverage (#+ Coverage)]]) + ["/." coverage (#+ Coverage)]]) (exception: #export (cannot-match-with-pattern {type Type} {pattern Code}) (ex.report ["Type" (%type type)] @@ -41,7 +43,7 @@ (exception: #export (non-exhaustive-pattern-matching {input Code} {branches (List [Code Code])} {coverage Coverage}) (ex.report ["Input" (%code input)] ["Branches" (%code (code.record branches))] - ["Coverage" (coverage.%coverage coverage)])) + ["Coverage" (/coverage.%coverage coverage)])) (exception: #export (cannot-have-empty-branches {message Text}) message) @@ -126,7 +128,7 @@ (def: (analyse-primitive type inputT cursor output next) (All [a] (-> Type Type Cursor Pattern (Operation a) (Operation [Pattern a]))) - (//.with-cursor cursor + (/.with-cursor cursor (do ///.monad [_ (//type.with-env (check.check inputT type)) @@ -153,29 +155,29 @@ (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) (.case pattern [cursor (#.Identifier ["" name])] - (//.with-cursor cursor + (/.with-cursor cursor (do ///.monad - [outputA (scope.with-local [name inputT] + [outputA (//scope.with-local [name inputT] next) - idx scope.next-local] - (wrap [(#//.Bind idx) outputA]))) + idx //scope.next-local] + (wrap [(#/.Bind idx) outputA]))) (^template [<type> <input> <output>] [cursor <input>] - (analyse-primitive <type> inputT cursor (#//.Simple <output>) next)) - ([Bit (#.Bit pattern-value) (#//.Bit pattern-value)] - [Nat (#.Nat pattern-value) (#//.Nat pattern-value)] - [Int (#.Int pattern-value) (#//.Int pattern-value)] - [Rev (#.Rev pattern-value) (#//.Rev pattern-value)] - [Frac (#.Frac pattern-value) (#//.Frac pattern-value)] - [Text (#.Text pattern-value) (#//.Text pattern-value)] - [Any (#.Tuple #.Nil) #//.Unit]) + (analyse-primitive <type> inputT cursor (#/.Simple <output>) next)) + ([Bit (#.Bit pattern-value) (#/.Bit pattern-value)] + [Nat (#.Nat pattern-value) (#/.Nat pattern-value)] + [Int (#.Int pattern-value) (#/.Int pattern-value)] + [Rev (#.Rev pattern-value) (#/.Rev pattern-value)] + [Frac (#.Frac pattern-value) (#/.Frac pattern-value)] + [Text (#.Text pattern-value) (#/.Text pattern-value)] + [Any (#.Tuple #.Nil) #/.Unit]) (^ [cursor (#.Tuple (list singleton))]) (analyse-pattern #.None inputT singleton next) [cursor (#.Tuple sub-patterns)] - (//.with-cursor cursor + (/.with-cursor cursor (do ///.monad [inputT' (simplify-case inputT)] (.case inputT' @@ -208,7 +210,7 @@ [nextA next] (wrap [(list) nextA])) (list.reverse matches))] - (wrap [(//.pattern/tuple memberP+) + (wrap [(/.pattern/tuple memberP+) thenA]))) _ @@ -217,18 +219,18 @@ [cursor (#.Record record)] (do ///.monad - [record (structure.normalize record) - [members recordT] (structure.order record) + [record (//structure.normalize record) + [members recordT] (//structure.order record) _ (//type.with-env (check.check inputT recordT))] (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next)) [cursor (#.Tag tag)] - (//.with-cursor cursor + (/.with-cursor cursor (analyse-pattern #.None inputT (` ((~ pattern))) next)) (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))]) - (//.with-cursor cursor + (/.with-cursor cursor (do ///.monad [inputT' (simplify-case inputT)] (.case inputT' @@ -251,7 +253,7 @@ lefts (if right? (dec idx) idx)]] - (wrap [(//.pattern/variant [lefts right? testP]) + (wrap [(/.pattern/variant [lefts right? testP]) nextA])) _ @@ -261,10 +263,10 @@ (///.throw cannot-match-with-pattern [inputT pattern])))) (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))]) - (//.with-cursor cursor + (/.with-cursor cursor (do ///.monad - [tag (extension.lift (macro.normalize tag)) - [idx group variantT] (extension.lift (macro.resolve-tag tag)) + [tag (///extension.lift (macro.normalize tag)) + [idx group variantT] (///extension.lift (macro.resolve-tag tag)) _ (//type.with-env (check.check inputT variantT))] (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next))) @@ -285,16 +287,16 @@ (function (_ [patternT bodyT]) (analyse-pattern #.None inputT patternT (analyse bodyT))) branchesT) - outputHC (|> outputH product.left coverage.determine) - outputTC (monad.map @ (|>> product.left coverage.determine) outputT) - _ (.case (monad.fold error.monad coverage.merge outputHC outputTC) + outputHC (|> outputH product.left /coverage.determine) + outputTC (monad.map @ (|>> product.left /coverage.determine) outputT) + _ (.case (monad.fold error.monad /coverage.merge outputHC outputTC) (#error.Success coverage) (///.assert non-exhaustive-pattern-matching [inputC branches coverage] - (coverage.exhaustive? coverage)) + (/coverage.exhaustive? coverage)) (#error.Failure error) (///.fail error))] - (wrap (#//.Case inputA [outputH outputT]))) + (wrap (#/.Case inputA [outputH outputT]))) #.Nil (///.throw cannot-have-empty-branches ""))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux index dc654fd40..24dd3051a 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux @@ -15,8 +15,9 @@ [collection ["." list ("#/." functor fold)] ["." dictionary (#+ Dictionary)]]]] - ["." //// ("#/." monad)] - ["." /// (#+ Pattern Variant Operation)]) + ["." //// ("#/." monad) + [// + ["/" analysis (#+ Pattern Variant Operation)]]]) (exception: #export (invalid-tuple-pattern) "Tuple size must be >= 2") @@ -91,30 +92,30 @@ (def: #export (determine pattern) (-> Pattern (Operation Coverage)) (case pattern - (^or (#///.Simple #///.Unit) - (#///.Bind _)) + (^or (#/.Simple #/.Unit) + (#/.Bind _)) (/////wrap #Exhaustive) ## Primitive patterns always have partial coverage because there ## are too many possibilities as far as values go. (^template [<tag>] - (#///.Simple (<tag> _)) + (#/.Simple (<tag> _)) (/////wrap #Partial)) - ([#///.Nat] - [#///.Int] - [#///.Rev] - [#///.Frac] - [#///.Text]) + ([#/.Nat] + [#/.Int] + [#/.Rev] + [#/.Frac] + [#/.Text]) ## Bits are the exception, since there is only "#1" and ## "#0", which means it is possible for bit ## pattern-matching to become exhaustive if complementary parts meet. - (#///.Simple (#///.Bit value)) + (#/.Simple (#/.Bit value)) (/////wrap (#Bit value)) ## Tuple patterns can be exhaustive if there is exhaustiveness for all of ## their sub-patterns. - (#///.Complex (#///.Tuple membersP+)) + (#/.Complex (#/.Tuple membersP+)) (case (list.reverse membersP+) (^or #.Nil (#.Cons _ #.Nil)) (////.throw invalid-tuple-pattern []) @@ -136,7 +137,7 @@ ## Variant patterns can be shown to be exhaustive if all the possible ## cases are handled exhaustively. - (#///.Complex (#///.Variant [lefts right? value])) + (#/.Complex (#/.Variant [lefts right? value])) (do ////.monad [value-coverage (determine value) #let [idx (if right? diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux deleted file mode 100644 index f79d36f4f..000000000 --- a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux +++ /dev/null @@ -1,130 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - ["ex" exception (#+ exception:)]] - [data - ["." error] - [text - format]] - ["." macro]] - ["." // (#+ Analysis Operation Phase) - ["." type] - ["." primitive] - ["." structure] - ["//." reference] - ["." case] - ["." function] - ["//." macro (#+ Expander)] - ["/." // - ["." extension] - [// - ["." reference]]]]) - -(exception: #export (unrecognized-syntax {code Code}) - (ex.report ["Code" (%code code)])) - -## TODO: Had to split the 'compile' function due to compilation issues -## with old-luxc. Must re-combine all the code ASAP - -(type: (Fix a) - (-> a a)) - -(def: (compile|primitive else code') - (Fix (-> (Code' (Ann Cursor)) (Operation Analysis))) - (case code' - (^template [<tag> <analyser>] - (<tag> value) - (<analyser> value)) - ([#.Bit primitive.bit] - [#.Nat primitive.nat] - [#.Int primitive.int] - [#.Rev primitive.rev] - [#.Frac primitive.frac] - [#.Text primitive.text]) - - _ - (else code'))) - -(def: (compile|structure compile else code') - (-> Phase (Fix (-> (Code' (Ann Cursor)) (Operation Analysis)))) - (case code' - (^template [<tag> <analyser>] - (^ (#.Form (list& [_ (<tag> tag)] - values))) - (case values - (#.Cons value #.Nil) - (<analyser> compile tag value) - - _ - (<analyser> compile tag (` [(~+ values)])))) - ([#.Nat structure.sum] - [#.Tag structure.tagged-sum]) - - (#.Tag tag) - (structure.tagged-sum compile tag (' [])) - - (^ (#.Tuple (list))) - primitive.unit - - (^ (#.Tuple (list singleton))) - (compile singleton) - - (^ (#.Tuple elems)) - (structure.product compile elems) - - (^ (#.Record pairs)) - (structure.record compile pairs) - - _ - (else code'))) - -(def: (compile|others expander compile code') - (-> Expander Phase (-> (Code' (Ann Cursor)) (Operation Analysis))) - (case code' - (#.Identifier reference) - (//reference.reference reference) - - (^ (#.Form (list [_ (#.Record branches)] input))) - (case.case compile input branches) - - (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) - (extension.apply compile [extension-name extension-args]) - - (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] - [_ (#.Identifier ["" arg-name])]))] - body))) - (function.function compile function-name arg-name body) - - (^ (#.Form (list& functionC argsC+))) - (do ///.monad - [[functionT functionA] (type.with-inference - (compile functionC))] - (case functionA - (#//.Reference (#reference.Constant def-name)) - (do @ - [?macro (extension.lift (macro.find-macro def-name))] - (case ?macro - (#.Some macro) - (do @ - [expansion (extension.lift (//macro.expand-one expander def-name macro argsC+))] - (compile expansion)) - - _ - (function.apply compile functionT functionA argsC+))) - - _ - (function.apply compile functionT functionA argsC+))) - - _ - (///.throw unrecognized-syntax [.dummy-cursor code']))) - -(def: #export (phase expander) - (-> Expander Phase) - (function (compile code) - (let [[cursor code'] code] - ## The cursor must be set in the state for the sake - ## of having useful error messages. - (//.with-cursor cursor - (compile|primitive (compile|structure compile (compile|others expander compile)) - code'))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/phase/analysis/function.lux index cbea165f8..bb75a313b 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/function.lux @@ -12,12 +12,14 @@ ["." type ["." check]] ["." macro]] - ["." // (#+ Analysis Operation Phase) - ["." scope] + [// + ["//." scope] ["//." type] - ["." inference] + ["//." inference] ["/." // - ["." extension]]]) + ["///." extension] + [// + ["/" analysis (#+ Analysis Operation Phase)]]]]) (exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code}) (ex.report ["Type" (%type expected)] @@ -36,7 +38,7 @@ (def: #export (function analyse function-name arg-name body) (-> Phase Text Text Code (Operation Analysis)) (do ///.monad - [functionT (extension.lift macro.expected-type)] + [functionT (///extension.lift macro.expected-type)] (loop [expectedT functionT] (///.with-stack cannot-analyse [expectedT function-name arg-name body] (case expectedT @@ -81,12 +83,12 @@ (#.Function inputT outputT) (<| (:: @ map (.function (_ [scope bodyA]) - (#//.Function (scope.environment scope) bodyA))) - //.with-scope + (#/.Function (//scope.environment scope) bodyA))) + /.with-scope ## Functions have access not only to their argument, but ## also to themselves, through a local variable. - (scope.with-local [function-name expectedT]) - (scope.with-local [arg-name inputT]) + (//scope.with-local [function-name expectedT]) + (//scope.with-local [arg-name inputT]) (//type.with-type outputT) (analyse body)) @@ -98,5 +100,5 @@ (-> Phase Type Analysis (List Code) (Operation Analysis)) (<| (///.with-stack cannot-apply [functionT argsC+]) (do ///.monad - [[applyT argsA+] (inference.general analyse functionT argsC+)]) - (wrap (//.apply [functionA argsA+])))) + [[applyT argsA+] (//inference.general analyse functionT argsC+)]) + (wrap (/.apply [functionA argsA+])))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux index 4ce9c6985..a99b06ac2 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux @@ -12,10 +12,12 @@ ["." type ["." check]] ["." macro]] - ["." /// ("#/." monad) - ["." extension]] - [// (#+ Tag Analysis Operation Phase)] - ["." //type]) + [// + ["//." type] + ["/." // ("#/." monad) + ["///." extension] + [// + ["/" analysis (#+ Tag Analysis Operation Phase)]]]]) (exception: #export (variant-tag-out-of-bounds {size Nat} {tag Tag} {type Type}) (ex.report ["Tag" (%n tag)] @@ -85,7 +87,7 @@ (def: new-named-type (Operation Type) (do ///.monad - [cursor (extension.lift macro.cursor) + [cursor (///extension.lift macro.cursor) [ex-id _] (//type.with-env check.existential)] (wrap (named-type cursor ex-id)))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux index 29865f352..ec9a3d5a0 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux @@ -13,9 +13,10 @@ [dictionary ["." plist]]]] ["." macro]] - ["." // (#+ Operation) - ["/." // - ["." extension]]]) + ["." /// + ["///." extension] + [// + ["/" analysis (#+ Operation)]]]) (type: #export Tag Text) @@ -63,26 +64,26 @@ (def: #export (set-annotations annotations) (-> Code (Operation Any)) - (do ///.monad - [self-name (extension.lift macro.current-module-name) - self (extension.lift macro.current-module)] - (case (get@ #.module-annotations self) - #.None - (extension.lift + (///extension.lift + (do ///.monad + [self-name macro.current-module-name + self macro.current-module] + (case (get@ #.module-annotations self) + #.None (function (_ state) (#error.Success [(update@ #.modules (plist.put self-name (set@ #.module-annotations (#.Some annotations) self)) state) - []]))) - - (#.Some old) - (///.throw cannot-set-module-annotations-more-than-once [self-name old annotations])))) + []])) + + (#.Some old) + (///.throw cannot-set-module-annotations-more-than-once [self-name old annotations]))))) (def: #export (import module) (-> Text (Operation Any)) - (do ///.monad - [self-name (extension.lift macro.current-module-name)] - (extension.lift + (///extension.lift + (do ///.monad + [self-name macro.current-module-name] (function (_ state) (#error.Success [(update@ #.modules (plist.update self-name (update@ #.imports (|>> (#.Cons module)))) @@ -91,9 +92,9 @@ (def: #export (alias alias module) (-> Text Text (Operation Any)) - (do ///.monad - [self-name (extension.lift macro.current-module-name)] - (extension.lift + (///extension.lift + (do ///.monad + [self-name macro.current-module-name] (function (_ state) (#error.Success [(update@ #.modules (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text])) @@ -103,7 +104,7 @@ (def: #export (exists? module) (-> Text (Operation Bit)) - (extension.lift + (///extension.lift (function (_ state) (|> state (get@ #.modules) @@ -113,10 +114,10 @@ (def: #export (define name definition) (-> Text Definition (Operation Any)) - (do ///.monad - [self-name (extension.lift macro.current-module-name) - self (extension.lift macro.current-module)] - (extension.lift + (///extension.lift + (do ///.monad + [self-name macro.current-module-name + self macro.current-module] (function (_ state) (case (plist.get name (get@ #.definitions self)) #.None @@ -134,7 +135,7 @@ (def: #export (create hash name) (-> Nat Text (Operation Any)) - (extension.lift + (///extension.lift (function (_ state) (let [module (new hash)] (#error.Success [(update@ #.modules @@ -146,15 +147,15 @@ (All [a] (-> Nat Text (Operation a) (Operation [Module a]))) (do ///.monad [_ (create hash name) - output (//.with-current-module name + output (/.with-current-module name action) - module (extension.lift (macro.find-module name))] + module (///extension.lift (macro.find-module name))] (wrap [module output]))) (do-template [<setter> <asker> <tag>] [(def: #export (<setter> module-name) (-> Text (Operation Any)) - (extension.lift + (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get module-name)) (#.Some module) @@ -174,7 +175,7 @@ (def: #export (<asker> module-name) (-> Text (Operation Bit)) - (extension.lift + (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get module-name)) (#.Some module) @@ -194,7 +195,7 @@ (do-template [<name> <tag> <type>] [(def: (<name> module-name) (-> Text (Operation <type>)) - (extension.lift + (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get module-name)) (#.Some module) @@ -226,7 +227,7 @@ (def: #export (declare-tags tags exported? type) (-> (List Tag) Bit Type (Operation Any)) (do ///.monad - [self-name (extension.lift macro.current-module-name) + [self-name (///extension.lift macro.current-module-name) [type-module type-name] (case type (#.Named type-name _) (wrap type-name) @@ -236,7 +237,7 @@ _ (ensure-undeclared-tags self-name tags) _ (///.assert cannot-declare-tags-for-foreign-type [tags type] (text/= self-name type-module))] - (extension.lift + (///extension.lift (function (_ state) (case (|> state (get@ #.modules) (plist.get self-name)) (#.Some module) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux index b65b6bc96..6e0a591d2 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux @@ -2,27 +2,29 @@ [lux (#- nat int rev) [control monad]] - ["." // (#+ Analysis Operation) - [".A" type] - ["/." //]]) + [// + ["//." type] + ["/." // + [// + ["/" analysis (#+ Analysis Operation)]]]]) (do-template [<name> <type> <tag>] [(def: #export (<name> value) (-> <type> (Operation Analysis)) (do ///.monad - [_ (typeA.infer <type>)] - (wrap (#//.Primitive (<tag> value)))))] + [_ (//type.infer <type>)] + (wrap (#/.Primitive (<tag> value)))))] - [bit Bit #//.Bit] - [nat Nat #//.Nat] - [int Int #//.Int] - [rev Rev #//.Rev] - [frac Frac #//.Frac] - [text Text #//.Text] + [bit Bit #/.Bit] + [nat Nat #/.Nat] + [int Int #/.Int] + [rev Rev #/.Rev] + [frac Frac #/.Frac] + [text Text #/.Text] ) (def: #export unit (Operation Analysis) (do ///.monad - [_ (typeA.infer Any)] - (wrap (#//.Primitive #//.Unit)))) + [_ (//type.infer Any)] + (wrap (#/.Primitive #/.Unit)))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux index 5969b9f5c..ee3767797 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux @@ -7,13 +7,14 @@ [data ["." text ("#/." equivalence) format]]] - ["." // (#+ Analysis Operation) - ["." scope] - ["." type] + [// + ["//." scope] + ["//." type] ["/." // - ["." extension] + ["///." extension] [// - ["." reference]]]]) + ["." reference] + ["/" analysis (#+ Analysis Operation)]]]]) (exception: #export (foreign-module-has-not-been-imported {current Text} {foreign Text}) (ex.report ["Current" current] @@ -25,23 +26,23 @@ ## [Analysers] (def: (definition def-name) (-> Name (Operation Analysis)) - (with-expansions [<return> (wrap (|> def-name reference.constant #//.Reference))] + (with-expansions [<return> (wrap (|> def-name reference.constant #/.Reference))] (do ///.monad - [[actualT def-anns _] (extension.lift (macro.find-def def-name))] + [[actualT def-anns _] (///extension.lift (macro.find-def def-name))] (case (macro.get-identifier-ann (name-of #.alias) def-anns) (#.Some real-def-name) (definition real-def-name) _ (do @ - [_ (type.infer actualT) - (^@ def-name [::module ::name]) (extension.lift (macro.normalize def-name)) - current (extension.lift macro.current-module-name)] + [_ (//type.infer actualT) + (^@ def-name [::module ::name]) (///extension.lift (macro.normalize def-name)) + current (///extension.lift macro.current-module-name)] (if (text/= current ::module) <return> (if (macro.export? def-anns) (do @ - [imported! (extension.lift (macro.imported-by? ::module current))] + [imported! (///extension.lift (macro.imported-by? ::module current))] (if imported! <return> (///.throw foreign-module-has-not-been-imported [current ::module]))) @@ -50,12 +51,12 @@ (def: (variable var-name) (-> Text (Operation (Maybe Analysis))) (do ///.monad - [?var (scope.find var-name)] + [?var (//scope.find var-name)] (case ?var (#.Some [actualT ref]) (do @ - [_ (type.infer actualT)] - (wrap (#.Some (|> ref reference.variable #//.Reference)))) + [_ (//type.infer actualT)] + (wrap (#.Some (|> ref reference.variable #/.Reference)))) #.None (wrap #.None)))) @@ -72,7 +73,7 @@ #.None (do @ - [this-module (extension.lift macro.current-module-name)] + [this-module (///extension.lift macro.current-module-name)] (definition [this-module simple-name])))) _ diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux index 69d7c80a9..a1b46a761 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux @@ -13,11 +13,11 @@ ["." list ("#/." functor fold monoid)] [dictionary ["." plist]]]]] - [// (#+ Operation Phase) - ["/." // - ["." extension] - [// - ["." reference (#+ Register Variable)]]]]) + ["." /// + ["///." extension] + [// + ["////." reference (#+ Register Variable)] + ["/" analysis (#+ Operation Phase)]]]) (type: Local (Bindings Text [Type Register])) (type: Foreign (Bindings Text [Type Variable])) @@ -34,7 +34,7 @@ (get@ [#.locals #.mappings]) (plist.get name) (maybe/map (function (_ [type value]) - [type (#reference.Local value)])))) + [type (#////reference.Local value)])))) (def: (captured? name scope) (-> Text Scope Bit) @@ -49,7 +49,7 @@ (case mappings (#.Cons [_name [_source-type _source-ref]] mappings') (if (text/= name _name) - (#.Some [_source-type (#reference.Foreign idx)]) + (#.Some [_source-type (#////reference.Foreign idx)]) (recur (inc idx) mappings')) #.Nil @@ -71,7 +71,7 @@ (def: #export (find name) (-> Text (Operation (Maybe [Type Variable]))) - (extension.lift + (///extension.lift (function (_ state) (let [[inner outer] (|> state (get@ #.scopes) @@ -85,7 +85,7 @@ (..reference name top-outer)) [ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) (function (_ scope ref+inner) - [(#reference.Foreign (get@ [#.captured #.counter] scope)) + [(#////reference.Foreign (get@ [#.captured #.counter] scope)) (#.Cons (update@ #.captured (: (-> Foreign Foreign) (|>> (update@ #.counter inc) @@ -181,7 +181,7 @@ (def: #export next-local (Operation Register) - (extension.lift + (///extension.lift (function (_ state) (case (get@ #.scopes state) (#.Cons top _) @@ -194,10 +194,10 @@ (-> Ref Variable) (case ref (#.Local register) - (#reference.Local register) + (#////reference.Local register) (#.Captured register) - (#reference.Foreign register))) + (#////reference.Foreign register))) (def: #export (environment scope) (-> Scope (List Variable)) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux index 3fb066259..e5a936226 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux @@ -20,12 +20,14 @@ ["." check]] ["." macro ["." code]]] - ["." // (#+ Tag Analysis Operation Phase) + [// ["//." type] - ["." primitive] - ["." inference] + ["//." primitive] + ["//." inference] ["/." // - ["." extension]]]) + ["///." extension] + [// + ["/" analysis (#+ Tag Analysis Operation Phase)]]]]) (exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code}) (ex.report ["Type" (%type type)] @@ -84,7 +86,7 @@ (def: #export (sum analyse tag valueC) (-> Phase Nat Code (Operation Analysis)) (do ///.monad - [expectedT (extension.lift macro.expected-type)] + [expectedT (///extension.lift macro.expected-type)] (///.with-stack cannot-analyse-variant [expectedT tag valueC] (case expectedT (#.Sum _) @@ -100,10 +102,10 @@ (do @ [valueA (//type.with-type variant-type (analyse valueC))] - (wrap (//.variant [lefts right? valueA]))) + (wrap (/.variant [lefts right? valueA]))) #.None - (///.throw inference.variant-tag-out-of-bounds [type-size tag expectedT]))) + (///.throw //inference.variant-tag-out-of-bounds [type-size tag expectedT]))) (#.Named name unnamedT) (//type.with-type unnamedT @@ -162,7 +164,7 @@ (def: (typed-product analyse members) (-> Phase (List Code) (Operation Analysis)) (do ///.monad - [expectedT (extension.lift macro.expected-type) + [expectedT (///extension.lift macro.expected-type) membersA+ (: (Operation (List Analysis)) (loop [membersT+ (type.flatten-tuple expectedT) membersC+ members] @@ -184,12 +186,12 @@ _ (///.throw cannot-analyse-tuple [expectedT members]))))] - (wrap (//.tuple membersA+)))) + (wrap (/.tuple membersA+)))) (def: #export (product analyse membersC) (-> Phase (List Code) (Operation Analysis)) (do ///.monad - [expectedT (extension.lift macro.expected-type)] + [expectedT (///extension.lift macro.expected-type)] (///.with-stack cannot-analyse-tuple [expectedT membersC] (case expectedT (#.Product _) @@ -216,7 +218,7 @@ _ (//type.with-env (check.check expectedT (type.tuple (list/map product.left membersTA))))] - (wrap (//.tuple (list/map product.right membersTA)))))) + (wrap (/.tuple (list/map product.right membersTA)))))) (^template [<tag> <instancer>] (<tag> _) @@ -256,20 +258,20 @@ (def: #export (tagged-sum analyse tag valueC) (-> Phase Name Code (Operation Analysis)) (do ///.monad - [tag (extension.lift (macro.normalize tag)) - [idx group variantT] (extension.lift (macro.resolve-tag tag)) - expectedT (extension.lift macro.expected-type)] + [tag (///extension.lift (macro.normalize tag)) + [idx group variantT] (///extension.lift (macro.resolve-tag tag)) + expectedT (///extension.lift macro.expected-type)] (case expectedT (#.Var _) (do @ [#let [case-size (list.size group)] - inferenceT (inference.variant idx case-size variantT) - [inferredT valueA+] (inference.general analyse inferenceT (list valueC)) + inferenceT (//inference.variant idx case-size variantT) + [inferredT valueA+] (//inference.general analyse inferenceT (list valueC)) #let [right? (n/= (dec case-size) idx) lefts (if right? (dec idx) idx)]] - (wrap (//.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) + (wrap (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) _ (..sum analyse idx valueC)))) @@ -285,7 +287,7 @@ (case key [_ (#.Tag key)] (do ///.monad - [key (extension.lift (macro.normalize key))] + [key (///extension.lift (macro.normalize key))] (wrap [key val])) _ @@ -304,8 +306,8 @@ (#.Cons [head-k head-v] _) (do ///.monad - [head-k (extension.lift (macro.normalize head-k)) - [_ tag-set recordT] (extension.lift (macro.resolve-tag head-k)) + [head-k (///extension.lift (macro.normalize head-k)) + [_ tag-set recordT] (///extension.lift (macro.resolve-tag head-k)) #let [size-record (list.size record) size-ts (list.size tag-set)] _ (if (n/= size-ts size-record) @@ -316,7 +318,7 @@ idx->val (monad.fold @ (function (_ [key val] idx->val) (do @ - [key (extension.lift (macro.normalize key))] + [key (///extension.lift (macro.normalize key))] (case (dictionary.get key tag->idx) (#.Some idx) (if (dictionary.contains? idx idx->val) @@ -340,20 +342,20 @@ [membersC recordT] (order members)] (case membersC (^ (list)) - primitive.unit + //primitive.unit (^ (list singletonC)) (analyse singletonC) _ (do @ - [expectedT (extension.lift macro.expected-type)] + [expectedT (///extension.lift macro.expected-type)] (case expectedT (#.Var _) (do @ - [inferenceT (inference.record recordT) - [inferredT membersA] (inference.general analyse inferenceT membersC)] - (wrap (//.tuple membersA))) + [inferenceT (//inference.record recordT) + [inferredT membersA] (//inference.general analyse inferenceT membersC)] + (wrap (/.tuple membersA))) _ (..product analyse membersC)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/type.lux b/stdlib/source/lux/tool/compiler/phase/analysis/type.lux index 75d691628..ae87615e4 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/type.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/type.lux @@ -6,19 +6,20 @@ ["." error]] ["." function] [type - ["tc" check]] + ["." check (#+ Check)]] ["." macro]] - [// (#+ Operation) - ["/." // - ["." extension]]]) + ["." /// + ["///." extension] + [// + ["/" analysis (#+ Operation)]]]) (def: #export (with-type expected) (All [a] (-> Type (Operation a) (Operation a))) - (extension.localized (get@ #.expected) (set@ #.expected) - (function.constant (#.Some expected)))) + (///extension.localized (get@ #.expected) (set@ #.expected) + (function.constant (#.Some expected)))) (def: #export (with-env action) - (All [a] (-> (tc.Check a) (Operation a))) + (All [a] (-> (Check a) (Operation a))) (function (_ (^@ stateE [bundle state])) (case (action (get@ #.type-context state)) (#error.Success [context' output]) @@ -30,23 +31,23 @@ (def: #export with-fresh-env (All [a] (-> (Operation a) (Operation a))) - (extension.localized (get@ #.type-context) (set@ #.type-context) - (function.constant tc.fresh-context))) + (///extension.localized (get@ #.type-context) (set@ #.type-context) + (function.constant check.fresh-context))) (def: #export (infer actualT) (-> Type (Operation Any)) (do ///.monad - [expectedT (extension.lift macro.expected-type)] + [expectedT (///extension.lift macro.expected-type)] (with-env - (tc.check expectedT actualT)))) + (check.check expectedT actualT)))) (def: #export (with-inference action) (All [a] (-> (Operation a) (Operation [Type a]))) (do ///.monad [[_ varT] (..with-env - tc.var) + check.var) output (with-type varT action) knownT (..with-env - (tc.clean varT))] + (check.clean varT))] (wrap [knownT output]))) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis.lux index 3b31f3d46..15e525d5d 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis.lux @@ -3,11 +3,10 @@ [data [collection ["." dictionary]]]] - [/// - [analysis (#+ Bundle)] - [// - [default - [evaluation (#+ Eval)]]]] + [//// + [default + [evaluation (#+ Eval)]] + [analysis (#+ Bundle)]] [/ ["." common] ["." host]]) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux index fa9b36270..ed71847c2 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux @@ -15,13 +15,14 @@ ["." /// ["." bundle] ["//." // - ["." analysis (#+ Analysis Handler Bundle) + [analysis [".A" type] [".A" case] [".A" function]] [// [default - [evaluation (#+ Eval)]]]]]) + [evaluation (#+ Eval)]] + ["." analysis (#+ Analysis Handler Bundle)]]]]) ## [Utils] (def: (simple inputsT+ outputT) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux index 3e44b42f4..7edc13cbd 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux @@ -25,10 +25,11 @@ ["/." // ["." bundle] ["//." // ("#/." monad) - ["." analysis (#+ Analysis Operation Handler Bundle) + [analysis [".A" type] - [".A" inference]]]]] - ) + [".A" inference]] + [// + ["." analysis (#+ Analysis Operation Handler Bundle)]]]]]) (type: Method-Signature {#method Type diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index 3d944b995..ee70ddfc5 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -10,17 +10,19 @@ ["." list ("#/." functor)] ["." dictionary]]] ["." macro] - [type (#+ :share) + [type (#+ :share :extract) ["." check]]] ["." // ["." bundle] ["/." // - ["." analysis + [analysis ["." module] ["." type]] ["." synthesis (#+ Synthesis)] ["." translation] - ["." statement (#+ Operation Handler Bundle)]]]) + ["." statement (#+ Operation Handler Bundle)] + [// + ["." analysis]]]]) ## TODO: Inline "evaluate!'" into "evaluate!" ASAP (def: (evaluate!' translate code//type codeS) @@ -181,11 +183,10 @@ (case inputsC+ (^ (list [_ (#.Text name)] valueC)) (do ///.monad - [[_ handlerT handlerV] (evaluate! (:of (:share [anchor expression statement] - {(Handler anchor expression statement) - handler} - {<type> - (:assume [])})) + [[_ handlerT handlerV] (evaluate! (:extract [anchor expression statement] + {(Handler anchor expression statement) + handler} + <type>) valueC)] (<| <scope> (//.install name) diff --git a/stdlib/source/lux/tool/compiler/phase/statement.lux b/stdlib/source/lux/tool/compiler/phase/statement.lux index c7ff3719f..f2d508843 100644 --- a/stdlib/source/lux/tool/compiler/phase/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/statement.lux @@ -1,10 +1,11 @@ (.module: [lux #*] ["." // - ["." analysis] ["." synthesis] ["." translation] - ["." extension]]) + ["." extension] + [// + ["." analysis]]]) (type: #export (Component state phase) {#state state diff --git a/stdlib/source/lux/tool/compiler/phase/statement/total.lux b/stdlib/source/lux/tool/compiler/phase/statement/total.lux index da2cc387c..e1ba173ad 100644 --- a/stdlib/source/lux/tool/compiler/phase/statement/total.lux +++ b/stdlib/source/lux/tool/compiler/phase/statement/total.lux @@ -2,31 +2,35 @@ [lux #* [control ["." monad (#+ do)] - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data [text format]] ["." macro]] ["." // (#+ Phase) ["/." // - ["." analysis - ["." expression] + [".P" analysis ["." type] ["///." macro (#+ Expander)]] - ["." extension]]]) + ["." extension] + [// + ["." analysis]]]]) (exception: #export (not-a-statement {code Code}) - (ex.report ["Statement" (%code code)])) + (exception.report + ["Statement" (%code code)])) (exception: #export (not-a-macro-call {code Code}) - (ex.report ["Code" (%code code)])) + (exception.report + ["Code" (%code code)])) (exception: #export (macro-was-not-found {name Name}) - (ex.report ["Name" (%name name)])) + (exception.report + ["Name" (%name name)])) (def: #export (phase expander) (-> Expander Phase) - (let [analyze (expression.phase expander)] + (let [analyze (analysisP.phase expander)] (function (compile code) (case code (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/synthesis.lux index 4cc9c7336..a484067bf 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis.lux @@ -12,10 +12,10 @@ ["." list ("#/." functor)] ["." dictionary (#+ Dictionary)]]]] ["." // - ["." analysis (#+ Environment Arity Composite Analysis)] ["." extension (#+ Extension)] [// - ["." reference (#+ Register Variable Reference)]]]) + ["." reference (#+ Register Variable Reference)] + ["." analysis (#+ Environment Arity Composite Analysis)]]]) (type: #export Resolver (Dictionary Variable Variable)) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux index 7c3f2e3ed..fe28c26df 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux @@ -16,9 +16,9 @@ ["." // (#+ Path Synthesis Operation Phase) ["." function] ["/." // ("#/." monad) - ["." analysis (#+ Pattern Match Analysis)] [// - ["." reference]]]]) + ["." reference] + ["." analysis (#+ Pattern Match Analysis)]]]]) (def: clean-up (-> Path Path) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux index b19488235..29fe623ba 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux @@ -13,10 +13,10 @@ ["." function] ["." case] ["/." // ("#/." monad) - ["." analysis (#+ Analysis)] ["." extension] [// - ["." reference]]]]) + ["." reference] + ["." analysis (#+ Analysis)]]]]) (def: (primitive analysis) (-> analysis.Primitive //.Primitive) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux index 49764fc08..a741238ab 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux @@ -13,9 +13,9 @@ ["." // (#+ Path Synthesis Operation Phase) ["." loop (#+ Transform)] ["/." // ("#/." monad) - ["." analysis (#+ Environment Arity Analysis)] [// - ["." reference (#+ Register Variable)]]]]) + ["." reference (#+ Register Variable)] + ["." analysis (#+ Environment Arity Analysis)]]]]) (exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment}) (ex.report ["Foreign" (%n foreign)] diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux index 28517bd42..8e0d51cd8 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux @@ -12,10 +12,10 @@ ["." syntax]]] ["." // (#+ Path Abstraction Synthesis) [// - ["." analysis (#+ Environment)] ["." extension] [// - ["." reference (#+ Register Variable)]]]]) + ["." reference (#+ Register Variable)] + ["." analysis (#+ Environment)]]]]) (type: #export (Transform a) (-> a (Maybe a))) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux index 5c17ed3d3..89536c579 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux @@ -19,10 +19,10 @@ [common ["common-." reference]] ["//." // ("#/." monad) - [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] [synthesis (#+ Synthesis)] [// [reference (#+ Register Variable)] + [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] ["." name]]]]]) (def: #export (apply translate [functionS argsS+]) diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux index 5a3a24175..8af864654 100644 --- a/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/translation/js/structure.lux @@ -8,8 +8,9 @@ ["//." runtime (#+ Operation Phase)] ["//." primitive] ["/." /// - [analysis (#+ Variant Tuple)] - ["." synthesis (#+ Synthesis)]]]) + ["." synthesis (#+ Synthesis)] + [// + [analysis (#+ Variant Tuple)]]]]) (def: #export (tuple translate elemsS+) (-> Phase (Tuple Synthesis) (Operation Expression)) |