aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/case
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/analysis/case.lux312
-rw-r--r--new-luxc/source/luxc/lang/analysis/case/coverage.lux106
2 files changed, 209 insertions, 209 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index 949e18a26..16f775907 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
@@ -16,11 +16,11 @@
(lang [type]
(type ["tc" check])))
(luxc ["&" lang]
- (lang ["&;" scope]
+ (lang ["&." scope]
["la" analysis]
- (analysis [";A" common]
- [";A" structure]
- (case [";A" coverage])))))
+ (analysis [".A" common]
+ [".A" structure]
+ (case [".A" coverage])))))
(exception: #export Cannot-Match-Type-With-Pattern)
(exception: #export Sum-Type-Has-No-Case)
@@ -38,11 +38,11 @@
(def: (re-quantify envs baseT)
(-> (List (List Type)) Type Type)
(case envs
- #;Nil
+ #.Nil
baseT
- (#;Cons head tail)
- (re-quantify tail (#;UnivQ head baseT))))
+ (#.Cons head tail)
+ (re-quantify tail (#.UnivQ head baseT))))
## Type-checking on the input value is done during the analysis of a
## "case" expression, to ensure that the patterns being used make
@@ -57,70 +57,70 @@
(list))
caseT caseT]
(case caseT
- (#;Var id)
- (do macro;Monad<Meta>
- [?caseT' (&;with-type-env
- (tc;read id))]
+ (#.Var id)
+ (do macro.Monad<Meta>
+ [?caseT' (&.with-type-env
+ (tc.read id))]
(case ?caseT'
- (#;Some caseT')
+ (#.Some caseT')
(recur envs caseT')
_
- (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
+ (&.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
- (#;Named name unnamedT)
+ (#.Named name unnamedT)
(recur envs unnamedT)
- (#;UnivQ env unquantifiedT)
- (recur (#;Cons env envs) unquantifiedT)
+ (#.UnivQ env unquantifiedT)
+ (recur (#.Cons env envs) unquantifiedT)
## (^template [<tag> <instancer>]
## (<tag> _)
- ## (do macro;Monad<Meta>
- ## [[_ instanceT] (&;with-type-env
+ ## (do macro.Monad<Meta>
+ ## [[_ instanceT] (&.with-type-env
## <instancer>)]
- ## (recur (maybe;assume (type;apply (list instanceT) caseT)))))
- ## ([#;UnivQ tc;var]
- ## [#;ExQ tc;existential])
+ ## (recur (maybe.assume (type.apply (list instanceT) caseT)))))
+ ## ([#.UnivQ tc.var]
+ ## [#.ExQ tc.existential])
- (#;ExQ _)
- (do macro;Monad<Meta>
- [[ex-id exT] (&;with-type-env
- tc;existential)]
- (recur envs (maybe;assume (type;apply (list exT) caseT))))
+ (#.ExQ _)
+ (do macro.Monad<Meta>
+ [[ex-id exT] (&.with-type-env
+ tc.existential)]
+ (recur envs (maybe.assume (type.apply (list exT) caseT))))
- (#;Apply inputT funcT)
+ (#.Apply inputT funcT)
(case funcT
- (#;Var funcT-id)
- (do macro;Monad<Meta>
- [funcT' (&;with-type-env
- (do tc;Monad<Check>
- [?funct' (tc;read funcT-id)]
+ (#.Var funcT-id)
+ (do macro.Monad<Meta>
+ [funcT' (&.with-type-env
+ (do tc.Monad<Check>
+ [?funct' (tc.read funcT-id)]
(case ?funct'
- (#;Some funct')
+ (#.Some funct')
(wrap funct')
_
- (tc;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))))]
- (recur envs (#;Apply inputT funcT')))
+ (tc.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))))]
+ (recur envs (#.Apply inputT funcT')))
_
- (case (type;apply (list inputT) funcT)
- (#;Some outputT)
+ (case (type.apply (list inputT) funcT)
+ (#.Some outputT)
(recur envs outputT)
- #;None
- (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
+ #.None
+ (&.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
- (#;Product _)
+ (#.Product _)
(|> caseT
- type;flatten-tuple
+ type.flatten-tuple
(list/map (re-quantify envs))
- type;tuple
- (:: macro;Monad<Meta> wrap))
+ type.tuple
+ (:: macro.Monad<Meta> wrap))
_
- (:: macro;Monad<Meta> wrap (re-quantify envs caseT)))))
+ (:: macro.Monad<Meta> wrap (re-quantify envs caseT)))))
## This function handles several concerns at once, but it must be that
## way because those concerns are interleaved when doing
@@ -139,169 +139,169 @@
## 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 (Meta a) (Meta [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<Meta>
- [outputA (&scope;with-local [name inputT]
+ [cursor (#.Symbol ["" name])]
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [outputA (&scope.with-local [name inputT]
next)
- idx &scope;next-local]
- (wrap [(` ("lux case bind" (~ (code;nat idx)))) outputA])))
+ idx &scope.next-local]
+ (wrap [(` ("lux case bind" (~ (code.nat idx)))) outputA])))
- [cursor (#;Symbol ident)]
- (&;with-cursor cursor
- (&;throw Symbols-Must-Be-Unqualified-Inside-Patterns (%ident ident)))
+ [cursor (#.Symbol ident)]
+ (&.with-cursor cursor
+ (&.throw Symbols-Must-Be-Unqualified-Inside-Patterns (%ident ident)))
(^template [<type> <code-tag>]
[cursor (<code-tag> test)]
- (&;with-cursor cursor
- (do macro;Monad<Meta>
- [_ (&;with-type-env
- (tc;check inputT <type>))
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [_ (&.with-type-env
+ (tc.check inputT <type>))
outputA next]
(wrap [pattern outputA]))))
- ([Bool #;Bool]
- [Nat #;Nat]
- [Int #;Int]
- [Deg #;Deg]
- [Frac #;Frac]
- [Text #;Text])
-
- (^ [cursor (#;Tuple (list))])
- (&;with-cursor cursor
- (do macro;Monad<Meta>
- [_ (&;with-type-env
- (tc;check inputT Unit))
+ ([Bool #.Bool]
+ [Nat #.Nat]
+ [Int #.Int]
+ [Deg #.Deg]
+ [Frac #.Frac]
+ [Text #.Text])
+
+ (^ [cursor (#.Tuple (list))])
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [_ (&.with-type-env
+ (tc.check inputT Unit))
outputA next]
(wrap [(` ("lux case tuple" [])) outputA])))
- (^ [cursor (#;Tuple (list singleton))])
- (analyse-pattern #;None inputT singleton next)
+ (^ [cursor (#.Tuple (list singleton))])
+ (analyse-pattern #.None inputT singleton next)
- [cursor (#;Tuple sub-patterns)]
- (&;with-cursor cursor
- (do macro;Monad<Meta>
+ [cursor (#.Tuple sub-patterns)]
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
[inputT' (simplify-case-type inputT)]
(case inputT'
- (#;Product _)
- (let [sub-types (type;flatten-tuple inputT')
- num-sub-types (maybe;default (list;size sub-types)
+ (#.Product _)
+ (let [sub-types (type.flatten-tuple inputT')
+ num-sub-types (maybe.default (list.size sub-types)
num-tags)
- num-sub-patterns (list;size sub-patterns)
- matches (cond (n.< num-sub-types num-sub-patterns)
- (let [[prefix suffix] (list;split (n.dec num-sub-patterns) sub-types)]
- (list;zip2 (list/compose prefix (list (type;tuple suffix))) sub-patterns))
-
- (n.> num-sub-types num-sub-patterns)
- (let [[prefix suffix] (list;split (n.dec num-sub-types) sub-patterns)]
- (list;zip2 sub-types (list/compose prefix (list (code;tuple suffix)))))
+ num-sub-patterns (list.size sub-patterns)
+ matches (cond (n/< num-sub-types num-sub-patterns)
+ (let [[prefix suffix] (list.split (n/dec num-sub-patterns) sub-types)]
+ (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns))
+
+ (n/> num-sub-types num-sub-patterns)
+ (let [[prefix suffix] (list.split (n/dec num-sub-types) sub-patterns)]
+ (list.zip2 sub-types (list/compose prefix (list (code.tuple suffix)))))
- ## (n.= num-sub-types num-sub-patterns)
- (list;zip2 sub-types sub-patterns)
+ ## (n/= num-sub-types num-sub-patterns)
+ (list.zip2 sub-types sub-patterns)
)]
(do @
[[memberP+ thenA] (list/fold (: (All [a]
- (-> [Type Code] (Meta [(List la;Pattern) a])
- (Meta [(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 (Meta a) (Meta [la;Pattern a])))
+ [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la.Pattern a])))
analyse-pattern)
- #;None memberT memberC then)]
+ #.None memberT memberC then)]
(wrap [(list& memberP memberP+) thenA]))))
(do @
[nextA next]
(wrap [(list) nextA]))
- (list;reverse matches))]
+ (list.reverse matches))]
(wrap [(` ("lux case tuple" [(~@ memberP+)]))
thenA])))
_
- (&;throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern))
+ (&.throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern))
)))
- [cursor (#;Record record)]
- (do macro;Monad<Meta>
- [record (structureA;normalize record)
- [members recordT] (structureA;order record)
- _ (&;with-type-env
- (tc;check inputT recordT))]
- (analyse-pattern (#;Some (list;size members)) inputT [cursor (#;Tuple members)] next))
-
- [cursor (#;Tag tag)]
- (&;with-cursor cursor
- (analyse-pattern #;None inputT (` ((~ pattern))) next))
-
- (^ [cursor (#;Form (list& [_ (#;Nat idx)] values))])
- (&;with-cursor cursor
- (do macro;Monad<Meta>
+ [cursor (#.Record record)]
+ (do macro.Monad<Meta>
+ [record (structureA.normalize record)
+ [members recordT] (structureA.order record)
+ _ (&.with-type-env
+ (tc.check inputT recordT))]
+ (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next))
+
+ [cursor (#.Tag tag)]
+ (&.with-cursor cursor
+ (analyse-pattern #.None inputT (` ((~ pattern))) next))
+
+ (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))])
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
[inputT' (simplify-case-type inputT)]
(case inputT'
- (#;Sum _)
- (let [flat-sum (type;flatten-variant inputT')
- size-sum (list;size flat-sum)
- num-cases (maybe;default size-sum num-tags)]
- (case (list;nth idx flat-sum)
- (^multi (#;Some case-type)
- (n.< num-cases idx))
- (if (and (n.> num-cases size-sum)
- (n.= (n.dec num-cases) idx))
- (do macro;Monad<Meta>
- [[testP nextA] (analyse-pattern #;None
- (type;variant (list;drop (n.dec num-cases) flat-sum))
+ (#.Sum _)
+ (let [flat-sum (type.flatten-variant inputT')
+ size-sum (list.size flat-sum)
+ num-cases (maybe.default size-sum num-tags)]
+ (case (list.nth idx flat-sum)
+ (^multi (#.Some case-type)
+ (n/< num-cases idx))
+ (if (and (n/> num-cases size-sum)
+ (n/= (n/dec num-cases) idx))
+ (do macro.Monad<Meta>
+ [[testP nextA] (analyse-pattern #.None
+ (type.variant (list.drop (n/dec num-cases) flat-sum))
(` [(~@ values)])
next)]
- (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP)))
+ (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
nextA]))
- (do macro;Monad<Meta>
- [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)]
- (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP)))
+ (do macro.Monad<Meta>
+ [[testP nextA] (analyse-pattern #.None case-type (` [(~@ values)]) next)]
+ (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
nextA])))
_
- (&;throw Sum-Type-Has-No-Case
+ (&.throw Sum-Type-Has-No-Case
(format "Case: " (%n idx) "\n"
"Type: " (%type inputT)))))
_
- (&;throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern)))))
+ (&.throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern)))))
- (^ [cursor (#;Form (list& [_ (#;Tag tag)] values))])
- (&;with-cursor cursor
- (do macro;Monad<Meta>
- [tag (macro;normalize tag)
- [idx group variantT] (macro;resolve-tag tag)
- _ (&;with-type-env
- (tc;check inputT variantT))]
- (analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next)))
+ (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
+ (&.with-cursor cursor
+ (do macro.Monad<Meta>
+ [tag (macro.normalize tag)
+ [idx group variantT] (macro.resolve-tag tag)
+ _ (&.with-type-env
+ (tc.check inputT variantT))]
+ (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~@ values))) next)))
_
- (&;throw Unrecognized-Pattern-Syntax (%code pattern))
+ (&.throw Unrecognized-Pattern-Syntax (%code pattern))
))
(def: #export (analyse-case analyse inputC branches)
- (-> &;Analyser Code (List [Code Code]) (Meta la;Analysis))
+ (-> &.Analyser Code (List [Code Code]) (Meta la.Analysis))
(case branches
- #;Nil
- (&;throw Cannot-Have-Empty-Branches "")
+ #.Nil
+ (&.throw Cannot-Have-Empty-Branches "")
- (#;Cons [patternH bodyH] branchesT)
- (do macro;Monad<Meta>
- [[inputT inputA] (commonA;with-unknown-type
+ (#.Cons [patternH bodyH] branchesT)
+ (do macro.Monad<Meta>
+ [[inputT inputA] (commonA.with-unknown-type
(analyse inputC))
- outputH (analyse-pattern #;None inputT patternH (analyse bodyH))
- outputT (monad;map @
+ outputH (analyse-pattern #.None inputT patternH (analyse bodyH))
+ outputT (monad.map @
(function [[patternT bodyT]]
- (analyse-pattern #;None inputT patternT (analyse bodyT)))
+ (analyse-pattern #.None inputT patternT (analyse bodyT)))
branchesT)
- outputHC (|> outputH product;left coverageA;determine)
- outputTC (monad;map @ (|>. product;left coverageA;determine) outputT)
- _ (case (monad;fold e;Monad<Error> coverageA;merge outputHC outputTC)
- (#e;Success coverage)
- (&;assert Non-Exhaustive-Pattern-Matching ""
- (coverageA;exhaustive? coverage))
-
- (#e;Error error)
- (&;fail error))]
- (wrap (` ("lux case" (~ inputA) (~ (code;record (list& outputH outputT)))))))))
+ outputHC (|> outputH product.left coverageA.determine)
+ outputTC (monad.map @ (|>> product.left coverageA.determine) outputT)
+ _ (case (monad.fold e.Monad<Error> coverageA.merge outputHC outputTC)
+ (#e.Success coverage)
+ (&.assert Non-Exhaustive-Pattern-Matching ""
+ (coverageA.exhaustive? coverage))
+
+ (#e.Error error)
+ (&.fail error))]
+ (wrap (` ("lux case" (~ inputA) (~ (code.record (list& outputH outputT)))))))))
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)))))
_