aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/case/coverage.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/case/coverage.lux')
-rw-r--r--new-luxc/source/luxc/lang/analysis/case/coverage.lux106
1 files changed, 53 insertions, 53 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
index 283e21d02..5d34387b4 100644
--- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux
+++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
@@ -45,7 +45,7 @@
(exception: #export Unknown-Pattern)
(def: #export (determine pattern)
- (-> la;Pattern (Meta Coverage))
+ (-> la.Pattern (Meta Coverage))
(case pattern
## Binding amounts to exhaustive coverage because any value can be
## matched that way.
@@ -59,14 +59,14 @@
## Primitive patterns always have partial coverage because there
## are too many possibilities as far as values go.
- (^or [_ (#;Nat _)] [_ (#;Int _)] [_ (#;Deg _)]
- [_ (#;Frac _)] [_ (#;Text _)])
+ (^or [_ (#.Nat _)] [_ (#.Int _)] [_ (#.Deg _)]
+ [_ (#.Frac _)] [_ (#.Text _)])
(macro/wrap #Partial)
## Bools are the exception, since there is only "true" and
## "false", which means it is possible for boolean
## pattern-matching to become exhaustive if complementary parts meet.
- [_ (#;Bool value)]
+ [_ (#.Bool value)]
(macro/wrap (#Bool value))
## Tuple patterns can be exhaustive if there is exhaustiveness for all of
@@ -74,11 +74,11 @@
(^code ("lux case tuple" [(~@ subs)]))
(loop [subs subs]
(case subs
- #;Nil
+ #.Nil
(macro/wrap #Exhaustive)
- (#;Cons sub subs')
- (do macro;Monad<Meta>
+ (#.Cons sub subs')
+ (do macro.Monad<Meta>
[pre (determine sub)
post (recur subs')]
(if (exhaustive? post)
@@ -87,15 +87,15 @@
## Variant patterns can be shown to be exhaustive if all the possible
## cases are handled exhaustively.
- (^code ("lux case variant" (~ [_ (#;Nat tag-id)]) (~ [_ (#;Nat num-tags)]) (~ sub)))
- (do macro;Monad<Meta>
+ (^code ("lux case variant" (~ [_ (#.Nat tag-id)]) (~ [_ (#.Nat num-tags)]) (~ sub)))
+ (do macro.Monad<Meta>
[=sub (determine sub)]
(wrap (#Variant num-tags
- (|> (dict;new number;Hash<Nat>)
- (dict;put tag-id =sub)))))
+ (|> (dict.new number.Hash<Nat>)
+ (dict.put tag-id =sub)))))
_
- (&;throw Unknown-Pattern (%code pattern))))
+ (&.throw Unknown-Pattern (%code pattern))))
(def: (xor left right)
(-> Bool Bool Bool)
@@ -109,8 +109,8 @@
## Because of that, the presence of redundant patterns is assumed to
## be a bug, likely due to programmer carelessness.
(def: redundant-pattern
- (e;Error Coverage)
- (e;fail "Redundant pattern."))
+ (e.Error Coverage)
+ (e.fail "Redundant pattern."))
(def: (flatten-alt coverage)
(-> Coverage (List Coverage))
@@ -131,8 +131,8 @@
(bool/= sideR sideS)
[(#Variant allR casesR) (#Variant allS casesS)]
- (and (n.= allR allS)
- (:: (dict;Eq<Dict> =) = casesR casesS))
+ (and (n/= allR allS)
+ (:: (dict.Eq<Dict> =) = casesR casesS))
[(#Seq leftR rightR) (#Seq leftS rightS)]
(and (= leftR leftS)
@@ -141,10 +141,10 @@
[(#Alt _) (#Alt _)]
(let [flatR (flatten-alt reference)
flatS (flatten-alt sample)]
- (and (n.= (list;size flatR) (list;size flatS))
- (list;every? (function [[coverageR coverageS]]
+ (and (n/= (list.size flatR) (list.size flatS))
+ (list.every? (function [[coverageR coverageS]]
(= coverageR coverageS))
- (list;zip2 flatR flatS))))
+ (list.zip2 flatR flatS))))
_
false)))
@@ -156,7 +156,7 @@
## pattern-matching expression is exhaustive and whether it contains
## redundant patterns.
(def: #export (merge addition so-far)
- (-> Coverage Coverage (e;Error Coverage))
+ (-> Coverage Coverage (e.Error Coverage))
(case [addition so-far]
## The addition cannot possibly improve the coverage.
[_ #Exhaustive]
@@ -175,28 +175,28 @@
(error/wrap #Exhaustive)
[(#Variant allA casesA) (#Variant allSF casesSF)]
- (cond (not (n.= allSF allA))
- (e;fail "Variants do not match.")
+ (cond (not (n/= allSF allA))
+ (e.fail "Variants do not match.")
- (:: (dict;Eq<Dict> Eq<Coverage>) = casesSF casesA)
+ (:: (dict.Eq<Dict> Eq<Coverage>) = casesSF casesA)
redundant-pattern
## else
- (do e;Monad<Error>
- [casesM (monad;fold @
+ (do e.Monad<Error>
+ [casesM (monad.fold @
(function [[tagA coverageA] casesSF']
- (case (dict;get tagA casesSF')
- (#;Some coverageSF)
+ (case (dict.get tagA casesSF')
+ (#.Some coverageSF)
(do @
[coverageM (merge coverageA coverageSF)]
- (wrap (dict;put tagA coverageM casesSF')))
-
- #;None
- (wrap (dict;put tagA coverageA casesSF'))))
- casesSF (dict;entries casesA))]
- (wrap (if (let [case-coverages (dict;values casesM)]
- (and (n.= allSF (list;size case-coverages))
- (list;every? exhaustive? case-coverages)))
+ (wrap (dict.put tagA coverageM casesSF')))
+
+ #.None
+ (wrap (dict.put tagA coverageA casesSF'))))
+ casesSF (dict.entries casesA))]
+ (wrap (if (let [case-coverages (dict.values casesM)]
+ (and (n/= allSF (list.size case-coverages))
+ (list.every? exhaustive? case-coverages)))
#Exhaustive
(#Variant allSF casesM)))))
@@ -212,7 +212,7 @@
## Same prefix
[true false]
- (do e;Monad<Error>
+ (do e.Monad<Error>
[rightM (merge rightA rightSF)]
(if (exhaustive? rightM)
## If all that follows is exhaustive, then it can be safely dropped
@@ -223,7 +223,7 @@
## Same suffix
[false true]
- (do e;Monad<Error>
+ (do e.Monad<Error>
[leftM (merge leftA leftSF)]
(wrap (#Seq leftM rightA))))
@@ -247,48 +247,48 @@
## This process must be repeated until no further productive
## merges can be done.
[_ (#Alt leftS rightS)]
- (do e;Monad<Error>
+ (do e.Monad<Error>
[#let [fuse-once (: (-> Coverage (List Coverage)
- (e;Error [(Maybe Coverage)
+ (e.Error [(Maybe Coverage)
(List Coverage)]))
(function [coverage possibilities]
(loop [alts possibilities]
(case alts
- #;Nil
- (wrap [#;None (list coverage)])
+ #.Nil
+ (wrap [#.None (list coverage)])
- (#;Cons alt alts')
+ (#.Cons alt alts')
(case (merge coverage alt)
- (#e;Success altM)
+ (#e.Success altM)
(case altM
(#Alt _)
(do @
[[success alts+] (recur alts')]
- (wrap [success (#;Cons alt alts+)]))
+ (wrap [success (#.Cons alt alts+)]))
_
- (wrap [(#;Some altM) alts']))
+ (wrap [(#.Some altM) alts']))
- (#e;Error error)
- (e;fail error))
+ (#e.Error error)
+ (e.fail error))
))))]
[success possibilities] (fuse-once addition (flatten-alt so-far))]
(loop [success success
possibilities possibilities]
(case success
- (#;Some coverage')
+ (#.Some coverage')
(do @
[[success' possibilities'] (fuse-once coverage' possibilities)]
(recur success' possibilities'))
- #;None
- (case (list;reverse possibilities)
- (#;Cons last prevs)
+ #.None
+ (case (list.reverse possibilities)
+ (#.Cons last prevs)
(wrap (list/fold (function [left right] (#Alt left right))
last
prevs))
- #;Nil
+ #.Nil
(undefined)))))
_
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-24 04:59:00 +0000