aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/analyser/case
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/analyser/case.lux58
-rw-r--r--new-luxc/source/luxc/analyser/case/coverage.lux40
2 files changed, 49 insertions, 49 deletions
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index 4b327fb6d..b65b9ff94 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -5,15 +5,15 @@
(data [bool]
[number]
[product]
- ["R" result]
+ ["e" error]
[maybe]
[text]
text/format
(coll [list "list/" Fold<List> Monoid<List> Functor<List>]))
- [macro]
- (macro [code])
- [type]
- (type ["tc" check]))
+ [meta]
+ (meta [code]
+ [type]
+ (type ["tc" check])))
(../.. ["&" base]
(lang ["la" analysis])
["&;" scope])
@@ -34,10 +34,10 @@
## This function makes it easier for "case" analysis to properly
## type-check the input with respect to the patterns.
(def: (simplify-case-type type)
- (-> Type (Lux Type))
+ (-> Type (Meta Type))
(case type
(#;Var id)
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[? (&;with-type-env
(tc;bound? id))]
(if ?
@@ -51,13 +51,13 @@
(simplify-case-type unnamedT)
(^or (#;UnivQ _) (#;ExQ _))
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[[ex-id exT] (&;with-type-env
tc;existential)]
(simplify-case-type (maybe;assume (type;apply (list exT) type))))
_
- (:: macro;Monad<Lux> wrap type)))
+ (:: meta;Monad<Meta> wrap type)))
## This function handles several concerns at once, but it must be that
## way because those concerns are interleaved when doing
@@ -76,11 +76,11 @@
## That is why the body must be analysed in the context of the
## pattern, and not separately.
(def: (analyse-pattern num-tags inputT pattern next)
- (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a])))
+ (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la;Pattern a])))
(case pattern
[cursor (#;Symbol ["" name])]
(&;with-cursor cursor
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[outputA (&scope;with-local [name inputT]
next)
idx &scope;next-local]
@@ -93,7 +93,7 @@
(^template [<type> <code-tag> <pattern-tag>]
[cursor (<code-tag> test)]
(&;with-cursor cursor
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[_ (&;with-type-env
(tc;check inputT <type>))
outputA next]
@@ -107,7 +107,7 @@
(^ [cursor (#;Tuple (list))])
(&;with-cursor cursor
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[_ (&;with-type-env
(tc;check inputT Unit))
outputA next]
@@ -118,7 +118,7 @@
[cursor (#;Tuple sub-patterns)]
(&;with-cursor cursor
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[inputT' (simplify-case-type inputT)]
(case inputT'
(#;Product _)
@@ -139,11 +139,11 @@
)]
(do @
[[memberP+ thenA] (list/fold (: (All [a]
- (-> [Type Code] (Lux [(List la;Pattern) a])
- (Lux [(List la;Pattern) a])))
+ (-> [Type Code] (Meta [(List la;Pattern) a])
+ (Meta [(List la;Pattern) a])))
(function [[memberT memberC] then]
(do @
- [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a])))
+ [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la;Pattern a])))
analyse-pattern)
#;None memberT memberC then)]
(wrap [(list& memberP memberP+) thenA]))))
@@ -158,7 +158,7 @@
)))
[cursor (#;Record record)]
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[record (&structure;normalize record)
[members recordT] (&structure;order record)
_ (&;with-type-env
@@ -171,7 +171,7 @@
(^ [cursor (#;Form (list& [_ (#;Nat idx)] values))])
(&;with-cursor cursor
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[inputT' (simplify-case-type inputT)]
(case inputT'
(#;Sum _)
@@ -183,14 +183,14 @@
(n.< num-cases idx))
(if (and (n.> num-cases size-sum)
(n.= (n.dec num-cases) idx))
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[[testP nextA] (analyse-pattern #;None
(type;variant (list;drop (n.dec num-cases) flat-sum))
(` [(~@ values)])
next)]
(wrap [(#la;VariantP idx num-cases testP)
nextA]))
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)]
(wrap [(#la;VariantP idx num-cases testP)
nextA])))
@@ -203,9 +203,9 @@
(^ [cursor (#;Form (list& [_ (#;Tag tag)] values))])
(&;with-cursor cursor
- (do macro;Monad<Lux>
- [tag (macro;normalize tag)
- [idx group variantT] (macro;resolve-tag tag)
+ (do meta;Monad<Meta>
+ [tag (meta;normalize tag)
+ [idx group variantT] (meta;resolve-tag tag)
_ (&;with-type-env
(tc;check inputT variantT))]
(analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next)))
@@ -215,13 +215,13 @@
))
(def: #export (analyse-case analyse input branches)
- (-> &;Analyser Code (List [Code Code]) (Lux la;Analysis))
+ (-> &;Analyser Code (List [Code Code]) (Meta la;Analysis))
(case branches
#;Nil
(&;fail "Cannot have empty branches in pattern-matching expression.")
(#;Cons [patternH bodyH] branchesT)
- (do macro;Monad<Lux>
+ (do meta;Monad<Meta>
[[inputT inputA] (&common;with-unknown-type
(analyse input))
outputH (analyse-pattern #;None inputT patternH (analyse bodyH))
@@ -229,15 +229,15 @@
(function [[patternT bodyT]]
(analyse-pattern #;None inputT patternT (analyse bodyT)))
branchesT)
- _ (case (monad;fold R;Monad<Result>
+ _ (case (monad;fold e;Monad<Error>
&&coverage;merge
(|> outputH product;left &&coverage;determine)
(list/map (|>. product;left &&coverage;determine) outputT))
- (#R;Success coverage)
+ (#e;Success coverage)
(if (&&coverage;exhaustive? coverage)
(wrap [])
(&;fail "Pattern-matching is not exhaustive."))
- (#R;Error error)
+ (#e;Error error)
(&;fail error))]
(wrap (#la;Case inputA (#;Cons outputH outputT))))))
diff --git a/new-luxc/source/luxc/analyser/case/coverage.lux b/new-luxc/source/luxc/analyser/case/coverage.lux
index 94aa06e9b..cb066a2bf 100644
--- a/new-luxc/source/luxc/analyser/case/coverage.lux
+++ b/new-luxc/source/luxc/analyser/case/coverage.lux
@@ -4,7 +4,7 @@
eq)
(data [bool "B/" Eq<Bool>]
[number]
- ["R" result "R/" Monad<Result>]
+ ["e" error "error/" Monad<Error>]
(coll [list "L/" Fold<List>]
["D" dict])))
(luxc (lang ["la" analysis])))
@@ -97,8 +97,8 @@
## Because of that, the presence of redundant patterns is assumed to
## be a bug, likely due to programmer carelessness.
(def: redundant-pattern
- (R;Result Coverage)
- (R;fail "Redundant pattern."))
+ (e;Error Coverage)
+ (e;fail "Redundant pattern."))
(def: (flatten-alt coverage)
(-> Coverage (List Coverage))
@@ -144,7 +144,7 @@
## pattern-matching expression is exhaustive and whether it contains
## redundant patterns.
(def: #export (merge addition so-far)
- (-> Coverage Coverage (R;Result Coverage))
+ (-> Coverage Coverage (e;Error Coverage))
(case [addition so-far]
## The addition cannot possibly improve the coverage.
[_ #Exhaustive]
@@ -152,25 +152,25 @@
## The addition completes the coverage.
[#Exhaustive _]
- (R/wrap #Exhaustive)
+ (error/wrap #Exhaustive)
[#Partial #Partial]
- (R/wrap #Partial)
+ (error/wrap #Partial)
## 2 boolean coverages are exhaustive if they compliment one another.
(^multi [(#Bool sideA) (#Bool sideSF)]
(xor sideA sideSF))
- (R/wrap #Exhaustive)
+ (error/wrap #Exhaustive)
[(#Variant allA casesA) (#Variant allSF casesSF)]
(cond (not (n.= allSF allA))
- (R;fail "Variants do not match.")
+ (e;fail "Variants do not match.")
(:: (D;Eq<Dict> Eq<Coverage>) = casesSF casesA)
redundant-pattern
## else
- (do R;Monad<Result>
+ (do e;Monad<Error>
[casesM (monad;fold @
(function [[tagA coverageA] casesSF']
(case (D;get tagA casesSF')
@@ -196,11 +196,11 @@
## The 2 sequences cannot possibly be merged.
[false false]
- (R/wrap (#Alt so-far addition))
+ (error/wrap (#Alt so-far addition))
## Same prefix
[true false]
- (do R;Monad<Result>
+ (do e;Monad<Error>
[rightM (merge rightA rightSF)]
(if (exhaustive? rightM)
## If all that follows is exhaustive, then it can be safely dropped
@@ -211,7 +211,7 @@
## Same suffix
[false true]
- (do R;Monad<Result>
+ (do e;Monad<Error>
[leftM (merge leftA leftSF)]
(wrap (#Seq leftM rightA))))
@@ -223,7 +223,7 @@
## The right part is not necessary, since it can always match the left.
(^multi [single (#Seq left right)]
(C/= left single))
- (R/wrap single)
+ (error/wrap single)
## When merging a new coverage against one based on Alt, it may be
## that one of the many coverages in the Alt is complementary to
@@ -235,10 +235,10 @@
## This process must be repeated until no further productive
## merges can be done.
[_ (#Alt leftS rightS)]
- (do R;Monad<Result>
+ (do e;Monad<Error>
[#let [fuse-once (: (-> Coverage (List Coverage)
- (R;Result [(Maybe Coverage)
- (List Coverage)]))
+ (e;Error [(Maybe Coverage)
+ (List Coverage)]))
(function [coverage possibilities]
(loop [alts possibilities]
(case alts
@@ -247,7 +247,7 @@
(#;Cons alt alts')
(case (merge coverage alt)
- (#R;Success altM)
+ (#e;Success altM)
(case altM
(#Alt _)
(do @
@@ -257,8 +257,8 @@
_
(wrap [(#;Some altM) alts']))
- (#R;Error error)
- (R;fail error))
+ (#e;Error error)
+ (e;fail error))
))))]
[success possibilities] (fuse-once addition (flatten-alt so-far))]
(loop [success success
@@ -284,4 +284,4 @@
## The addition cannot possibly improve the coverage.
redundant-pattern
## There are now 2 alternative paths.
- (R/wrap (#Alt so-far addition)))))
+ (error/wrap (#Alt so-far addition)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-15 05:09:13 +0000