git.iko.soy/elk
on master help sign in
Update Nitpick from using Can.CtorAlts to using Can.Union
7149cfeEvan Czaplicki
src/Nitpick/PatternMatches.hs+68−42
compare with master
unifiedsplit
@@ -23,6 +23,8 @@ import qualified Data.Maybe as Maybe
23import qualified Data.Text as Text
23import qualified Data.Text as Text
24
24
25import qualified AST.Canonical as Can
25import qualified AST.Canonical as Can
26+import qualified AST.Module.Name as ModuleName
27+import qualified Data.Index as Index
26import qualified Elm.Name as N
28import qualified Elm.Name as N
27import qualified Reporting.Annotation as A
29import qualified Reporting.Annotation as A
28import qualified Reporting.Region as R
30import qualified Reporting.Region as R
@@ -35,8 +37,7 @@ import qualified Reporting.Region as R
35data Pattern
37data Pattern
36 = Anything
38 = Anything
37 | Literal Literal
39 | Literal Literal
38− | Ctor Can.CtorAlts N.Name [Pattern]
40+ | Ctor Can.Union N.Name [Pattern]
39− deriving (Eq)
40
41
41
42
42data Literal
43data Literal
@@ -63,16 +64,16 @@ simplify (A.At _ pattern) =
63 Anything
64 Anything
64
65
65 Can.PUnit ->
66 Can.PUnit ->
66− Ctor unitAlts unitName []
67+ Ctor unit unitName []
67
68
68 Can.PTuple a b Nothing ->
69 Can.PTuple a b Nothing ->
69− Ctor pairAlts pairName [ simplify a, simplify b ]
70+ Ctor pair pairName [ simplify a, simplify b ]
70
71
71 Can.PTuple a b (Just c) ->
72 Can.PTuple a b (Just c) ->
72− Ctor tripleAlts tripleName [ simplify a, simplify b, simplify c ]
73+ Ctor triple tripleName [ simplify a, simplify b, simplify c ]
73
74
74− Can.PCtor _ _ _ alts name _ args ->
75+ Can.PCtor _ _ union name _ args ->
75− Ctor alts name $
76+ Ctor union name $
76 map (\(Can.PatternCtorArg _ _ arg) -> simplify arg) args
77 map (\(Can.PatternCtorArg _ _ arg) -> simplify arg) args
77
78
78 Can.PList entries ->
79 Can.PList entries ->
@@ -96,41 +97,63 @@ simplify (A.At _ pattern) =
96
97
97cons :: Can.Pattern -> Pattern -> Pattern
98cons :: Can.Pattern -> Pattern -> Pattern
98cons hd tl =
99cons hd tl =
99− Ctor listAlts consName [ simplify hd, tl ]
100+ Ctor list consName [ simplify hd, tl ]
100
101
101
102
102{-# NOINLINE nil #-}
103{-# NOINLINE nil #-}
103nil :: Pattern
104nil :: Pattern
104nil =
105nil =
105− Ctor listAlts nilName []
106+ Ctor list nilName []
106
107
107
108
108
109
109−-- ALTS
110+-- BUILT-IN UNIONS
110
111
111
112
112−{-# NOINLINE unitAlts #-}
113+{-# NOINLINE unit #-}
113−unitAlts :: Can.CtorAlts
114+unit :: Can.Union
114−unitAlts =
115+unit =
116+ let
117+ ctor =
115− Can.toAlts [ Can.CtorAlt unitName 0 ]
118+ Can.Ctor unitName Index.first 0 []
119+ in
120+ Can.Union [] [ ctor ] 1 Can.Normal
116
121
117
122
118−{-# NOINLINE pairAlts #-}
123+{-# NOINLINE pair #-}
119−pairAlts :: Can.CtorAlts
124+pair :: Can.Union
120−pairAlts =
125+pair =
121− Can.toAlts [ Can.CtorAlt pairName 2 ]
126+ let
127+ ctor =
128+ Can.Ctor pairName Index.first 2 [Can.TVar "a", Can.TVar "b"]
129+ in
130+ Can.Union ["a","b"] [ ctor ] 1 Can.Normal
122
131
123
132
124−{-# NOINLINE tripleAlts #-}
133+{-# NOINLINE triple #-}
125−tripleAlts :: Can.CtorAlts
134+triple :: Can.Union
126−tripleAlts =
135+triple =
127− Can.toAlts [ Can.CtorAlt tripleName 3 ]
136+ let
137+ ctor =
138+ Can.Ctor pairName Index.first 3 [Can.TVar "a", Can.TVar "b", Can.TVar "c"]
139+ in
140+ Can.Union ["a","b","c"] [ ctor ] 1 Can.Normal
128
141
129
142
130−{-# NOINLINE listAlts #-}
143+{-# NOINLINE list #-}
131−listAlts :: Can.CtorAlts
144+list :: Can.Union
132−listAlts =
145+list =
133− Can.toAlts [ Can.CtorAlt consName 2, Can.CtorAlt nilName 0 ]
146+ let
147+ nilCtor =
148+ Can.Ctor nilName Index.first 0 []
149+
150+ consCtor =
151+ Can.Ctor consName Index.second 2
152+ [ Can.TVar "a"
153+ , Can.TType ModuleName.list N.list [Can.TVar "a"]
154+ ]
155+ in
156+ Can.Union ["a"] [ nilCtor, consCtor ] 2 Can.Normal
134
157
135
158
136{-# NOINLINE unitName #-}
159{-# NOINLINE unitName #-}
@@ -247,6 +270,9 @@ checkExpr (A.At region expression) errors =
247 Can.VarForeign _ _ _ ->
270 Can.VarForeign _ _ _ ->
248 errors
271 errors
249
272
273+ Can.VarCtor _ _ _ _ _ ->
274+ errors
275+
250 Can.VarDebug _ _ _ ->
276 Can.VarDebug _ _ _ ->
251 errors
277 errors
252
278
@@ -403,7 +429,7 @@ isExhaustive matrix n =
403 <$> isExhaustive (Maybe.mapMaybe specializeRowByAnything matrix) (n - 1)
429 <$> isExhaustive (Maybe.mapMaybe specializeRowByAnything matrix) (n - 1)
404
430
405 else
431 else
406− let alts@(Can.CtorAlts numAlts altList) = snd (Map.findMin ctors) in
432+ let alts@(Can.Union _ altList numAlts _) = snd (Map.findMin ctors) in
407 if numSeen < numAlts then
433 if numSeen < numAlts then
408 (:)
434 (:)
409 <$> Maybe.mapMaybe (isMissing alts ctors) altList
435 <$> Maybe.mapMaybe (isMissing alts ctors) altList
@@ -411,7 +437,7 @@ isExhaustive matrix n =
411
437
412 else
438 else
413 let
439 let
414− isAltExhaustive (Can.CtorAlt name arity) =
440+ isAltExhaustive (Can.Ctor name _ arity _) =
415 recoverCtor alts name arity <$>
441 recoverCtor alts name arity <$>
416 isExhaustive
442 isExhaustive
417 (Maybe.mapMaybe (specializeRowByCtor name arity) matrix)
443 (Maybe.mapMaybe (specializeRowByCtor name arity) matrix)
@@ -420,21 +446,21 @@ isExhaustive matrix n =
420 concatMap isAltExhaustive altList
446 concatMap isAltExhaustive altList
421
447
422
448
423−isMissing :: Can.CtorAlts -> Map.Map N.Name a -> Can.CtorAlt -> Maybe Pattern
449+isMissing :: Can.Union -> Map.Map N.Name a -> Can.Ctor -> Maybe Pattern
424−isMissing alts ctors (Can.CtorAlt name arity) =
450+isMissing union ctors (Can.Ctor name _ arity _) =
425 if Map.member name ctors then
451 if Map.member name ctors then
426 Nothing
452 Nothing
427 else
453 else
428− Just (Ctor alts name (replicate arity Anything))
454+ Just (Ctor union name (replicate arity Anything))
429
455
430
456
431−recoverCtor :: Can.CtorAlts -> N.Name -> Int -> [Pattern] -> [Pattern]
457+recoverCtor :: Can.Union -> N.Name -> Int -> [Pattern] -> [Pattern]
432−recoverCtor alts name arity patterns =
458+recoverCtor union name arity patterns =
433 let
459 let
434 (args, rest) =
460 (args, rest) =
435 splitAt arity patterns
461 splitAt arity patterns
436 in
462 in
437− Ctor alts name args : rest
463+ Ctor union name args : rest
438
464
439
465
440
466
@@ -499,9 +525,9 @@ isUseful matrix vector =
499 -- of those. But what if some of those Ctors have subpatterns
525 -- of those. But what if some of those Ctors have subpatterns
500 -- that make them less general? If so, this actually is useful!
526 -- that make them less general? If so, this actually is useful!
501 let
527 let
502− isUsefulAlt (Can.CtorAlt ctor arity) =
528+ isUsefulAlt (Can.Ctor name _ arity _) =
503 isUseful
529 isUseful
504− (Maybe.mapMaybe (specializeRowByCtor ctor arity) matrix)
530+ (Maybe.mapMaybe (specializeRowByCtor name arity) matrix)
505 (replicate arity Anything ++ patterns)
531 (replicate arity Anything ++ patterns)
506 in
532 in
507 any isUsefulAlt alts
533 any isUsefulAlt alts
@@ -579,7 +605,7 @@ specializeRowByAnything row =
579
605
580
606
581data Complete
607data Complete
582− = Yes [Can.CtorAlt]
608+ = Yes [Can.Ctor]
583 | No
609 | No
584
610
585
611
@@ -592,7 +618,7 @@ isComplete matrix =
592 if numSeen == 0 then
618 if numSeen == 0 then
593 No
619 No
594 else
620 else
595− let (Can.CtorAlts numAlts alts) = snd (Map.findMin ctors) in
621+ let (Can.Union _ alts numAlts _) = snd (Map.findMin ctors) in
596 if numSeen == numAlts then Yes alts else No
622 if numSeen == numAlts then Yes alts else No
597
623
598
624
@@ -600,16 +626,16 @@ isComplete matrix =
600-- COLLECT CTORS
626-- COLLECT CTORS
601
627
602
628
603−collectCtors :: [[Pattern]] -> Map.Map N.Name Can.CtorAlts
629+collectCtors :: [[Pattern]] -> Map.Map N.Name Can.Union
604collectCtors matrix =
630collectCtors matrix =
605 List.foldl' collectCtorsHelp Map.empty matrix
631 List.foldl' collectCtorsHelp Map.empty matrix
606
632
607
633
608−collectCtorsHelp :: Map.Map N.Name Can.CtorAlts -> [Pattern] -> Map.Map N.Name Can.CtorAlts
634+collectCtorsHelp :: Map.Map N.Name Can.Union -> [Pattern] -> Map.Map N.Name Can.Union
609collectCtorsHelp ctors row =
635collectCtorsHelp ctors row =
610 case row of
636 case row of
611− Ctor alts name _ : _ ->
637+ Ctor union name _ : _ ->
612− Map.insert name alts ctors
638+ Map.insert name union ctors
613
639
614 _ ->
640 _ ->
615 ctors
641 ctors