diff options
| -rw-r--r-- | new-luxc/source/luxc/analyser/case.lux | 57 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/structure.lux | 21 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis.lux | 18 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/pattern.lux | 14 |
4 files changed, 52 insertions, 58 deletions
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux index d5c84b7bf..f3eec6b6b 100644 --- a/new-luxc/source/luxc/analyser/case.lux +++ b/new-luxc/source/luxc/analyser/case.lux @@ -16,8 +16,7 @@ [type] (type ["TC" check])) (luxc ["&" base] - (lang ["la" analysis #+ Analysis] - ["lp" pattern #+ Pattern]) + (lang ["la" analysis]) ["&;" env] (analyser ["&;" common] ["&;" structure]))) @@ -62,7 +61,7 @@ (:: Monad<Lux> wrap type))) (def: (analyse-pattern num-tags inputT pattern next) - (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [Pattern a]))) + (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a]))) (case pattern [cursor (#;Symbol ["" name])] (&;with-cursor cursor @@ -70,7 +69,7 @@ [outputA (&env;with-local [name inputT] next) idx &env;next-local] - (wrap [(#lp;Bind idx) outputA]))) + (wrap [(#la;BindP idx) outputA]))) [cursor (#;Symbol ident)] (&;with-cursor cursor @@ -84,13 +83,13 @@ (TC;check inputT <type>)) outputA next] (wrap [(<pattern-tag> test) outputA])))) - ([Bool #;Bool #lp;Bool] - [Nat #;Nat #lp;Nat] - [Int #;Int #lp;Int] - [Deg #;Deg #lp;Deg] - [Real #;Real #lp;Real] - [Char #;Char #lp;Char] - [Text #;Text #lp;Text]) + ([Bool #;Bool #la;BoolP] + [Nat #;Nat #la;NatP] + [Int #;Int #la;IntP] + [Deg #;Deg #la;DegP] + [Real #;Real #la;RealP] + [Char #;Char #la;CharP] + [Text #;Text #la;TextP]) (^ [cursor (#;Tuple (list))]) (&;with-cursor cursor @@ -98,7 +97,7 @@ [_ (&;within-type-env (TC;check inputT Unit)) outputA next] - (wrap [(#lp;Tuple (list)) outputA]))) + (wrap [(#la;TupleP (list)) outputA]))) (^ [cursor (#;Tuple (list singleton))]) (analyse-pattern #;None inputT singleton next) @@ -126,11 +125,11 @@ )] (do @ [[memberP+ thenA] (L/fold (: (All [a] - (-> [Type Code] (Lux [(List Pattern) a]) - (Lux [(List Pattern) a]))) + (-> [Type Code] (Lux [(List la;Pattern) a]) + (Lux [(List la;Pattern) a]))) (function [[memberT memberC] then] (do @ - [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [Pattern a]))) + [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a]))) analyse-pattern) #;None memberT memberC then)] (wrap [(list& memberP memberP+) thenA])))) @@ -138,7 +137,7 @@ [nextA next] (wrap [(list) nextA])) matches)] - (wrap [(#lp;Tuple memberP+) thenA]))) + (wrap [(#la;TupleP memberP+) thenA]))) _ (&;fail (pattern-error inputT pattern)) @@ -175,11 +174,11 @@ (type;variant (list;drop (n.dec num-cases) flat-sum)) (` [(~@ values)]) next)] - (wrap [(#lp;Variant idx num-cases testP) + (wrap [(#la;VariantP idx num-cases testP) nextA])) (do Monad<Lux> [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)] - (wrap [(#lp;Variant idx num-cases testP) + (wrap [(#la;VariantP idx num-cases testP) nextA]))) _ @@ -202,7 +201,7 @@ )) (def: (analyse-branch analyse inputT pattern body) - (-> &;Analyser Type Code Code (Lux [Pattern Analysis])) + (-> &;Analyser Type Code Code (Lux [la;Pattern la;Analysis])) (analyse-pattern #;None inputT pattern (analyse body))) (do-template [<name> <tag>] @@ -220,22 +219,22 @@ ) (def: (determine-coverage pattern) - (-> Pattern Coverage) + (-> la;Pattern Coverage) (case pattern - (^or (#lp;Bind _) (^ (#lp;Tuple (list)))) + (^or (#la;BindP _) (^ (#la;TupleP (list)))) #TotalC - (^ (#lp;Tuple (list singleton))) + (^ (#la;TupleP (list singleton))) (determine-coverage singleton) - (#lp;Bool value) + (#la;BoolP value) (#BoolC value) - (^or (#lp;Nat _) (#lp;Int _) (#lp;Deg _) - (#lp;Real _) (#lp;Char _) (#lp;Text _)) + (^or (#la;NatP _) (#la;IntP _) (#la;DegP _) + (#la;RealP _) (#la;CharP _) (#la;TextP _)) #PartialC - (#lp;Tuple subs) + (#la;TupleP subs) (loop [subs subs] (case subs #;Nil @@ -248,7 +247,7 @@ (#SeqC (determine-coverage sub) post))))) - (#lp;Variant tag-id num-tags sub) + (#la;VariantP tag-id num-tags sub) (#VariantC num-tags (|> (D;new number;Hash<Nat>) (D;put tag-id (determine-coverage sub)))))) @@ -432,11 +431,11 @@ (R/wrap (#AltC so-far addition))))) (def: get-coverage - (-> [Pattern Analysis] Coverage) + (-> [la;Pattern la;Analysis] Coverage) (|>. product;left determine-coverage)) (def: #export (analyse-case analyse input branches) - (-> &;Analyser Code (List [Code Code]) (Lux Analysis)) + (-> &;Analyser Code (List [Code Code]) (Lux la;Analysis)) (case branches #;Nil (&;fail "Cannot have empty branches in pattern-matching expression.") diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux index ab6f6adae..9447ea059 100644 --- a/new-luxc/source/luxc/analyser/structure.lux +++ b/new-luxc/source/luxc/analyser/structure.lux @@ -18,8 +18,7 @@ [type] (type ["TC" check])) (luxc ["&" base] - (lang ["la" analysis #+ Analysis] - ["lp" pattern]) + (lang ["la" analysis]) ["&;" module] ["&;" env] (analyser ["&;" common] @@ -27,7 +26,7 @@ ## [Analysers] (def: (analyse-typed-product analyse members) - (-> &;Analyser (List Code) (Lux Analysis)) + (-> &;Analyser (List Code) (Lux la;Analysis)) (do Monad<Lux> [expected macro;expected-type] (loop [expected expected @@ -109,7 +108,7 @@ (:: Monad<Lux> wrap [(list) Unit]))) (def: (tuple members) - (-> (List Analysis) Analysis) + (-> (List la;Analysis) la;Analysis) (case members #;Nil #la;Unit @@ -121,7 +120,7 @@ (#la;Product left (tuple right)))) (def: #export (analyse-product analyse membersC) - (-> &;Analyser (List Code) (Lux Analysis)) + (-> &;Analyser (List Code) (Lux la;Analysis)) (do Monad<Lux> [expected macro;expected-type] (&;with-stacked-errors @@ -244,7 +243,7 @@ (&;fail (format "Not a variant type: " (%type type))))) (def: #export (analyse-record analyse members) - (-> &;Analyser (List [Code Code]) (Lux Analysis)) + (-> &;Analyser (List [Code Code]) (Lux la;Analysis)) (do Monad<Lux> [members (normalize-record members) [members recordT] (order-record members) @@ -257,14 +256,14 @@ (do-template [<name> <side>] [(def: (<name> inner) - (-> Analysis Analysis) + (-> la;Analysis la;Analysis) (#la;Sum (<side> inner)))] [sum-left #;Left] [sum-right #;Right]) (def: (variant tag size temp value) - (-> Nat Nat Nat Analysis Analysis) + (-> Nat Nat Nat la;Analysis la;Analysis) (if (n.= (n.dec size) tag) (if (n.= +1 tag) (sum-right value) @@ -274,7 +273,7 @@ (L/fold (function;const sum-left) (case value (#la;Sum _) - (#la;Case value (list [(#lp;Bind temp) + (#la;Case value (list [(#la;BindP temp) (#la;Relative (#;Local temp))])) _ @@ -282,7 +281,7 @@ (list;n.range +0 tag)))) (def: #export (analyse-tagged-sum analyse tag value) - (-> &;Analyser Ident Code (Lux Analysis)) + (-> &;Analyser Ident Code (Lux la;Analysis)) (do Monad<Lux> [tag (macro;normalize tag) [idx group variantT] (macro;resolve-tag tag) @@ -296,7 +295,7 @@ (wrap (variant idx case-size temp (|> valueA+ list;head assume))))) (def: #export (analyse-sum analyse tag valueC) - (-> &;Analyser Nat Code (Lux Analysis)) + (-> &;Analyser Nat Code (Lux la;Analysis)) (do Monad<Lux> [expected macro;expected-type] (&;with-stacked-errors diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux index 3cd63b65f..b96bd9ba2 100644 --- a/new-luxc/source/luxc/lang/analysis.lux +++ b/new-luxc/source/luxc/lang/analysis.lux @@ -1,7 +1,17 @@ (;module: - lux - (lux (data [product])) - (.. ["lp" pattern])) + lux) + +(type: #export #rec Pattern + (#BindP Nat) + (#BoolP Bool) + (#NatP Nat) + (#IntP Int) + (#DegP Deg) + (#RealP Real) + (#CharP Char) + (#TextP Text) + (#TupleP (List Pattern)) + (#VariantP Nat Nat Pattern)) (type: #export #rec Analysis #Unit @@ -14,7 +24,7 @@ (#Text Text) (#Sum (Either Analysis Analysis)) (#Product Analysis Analysis) - (#Case Analysis (List [lp;Pattern Analysis])) + (#Case Analysis (List [Pattern Analysis])) (#Function Scope Analysis) (#Apply Analysis Analysis) (#Procedure Text (List Analysis)) diff --git a/new-luxc/source/luxc/lang/pattern.lux b/new-luxc/source/luxc/lang/pattern.lux deleted file mode 100644 index 0b51e6284..000000000 --- a/new-luxc/source/luxc/lang/pattern.lux +++ /dev/null @@ -1,14 +0,0 @@ -(;module: - lux) - -(type: #export #rec Pattern - (#Bind Nat) - (#Bool Bool) - (#Nat Nat) - (#Int Int) - (#Deg Deg) - (#Real Real) - (#Char Char) - (#Text Text) - (#Tuple (List Pattern)) - (#Variant Nat Nat Pattern)) |