77f542d · elk · git.iko.soy

src/AST/Canonical.hs+2

compare with master

unifiedsplit

@@ -153,10 +153,12 @@ data Pattern_

153 , _p_vars :: [N.Name]

154 , _p_alts :: CtorAlts

155 , _p_name :: N.Name

156+ , _p_index :: Index.ZeroBased

156 , _p_args :: [PatternCtorArg]

157 , _p_args :: [PatternCtorArg]

157 }

158 }

158 -- CACHE _p_home, _p_type, and _p_vars for type inference

159 -- CACHE _p_home, _p_type, and _p_vars for type inference

159 -- CACHE _p_alts for exhaustiveness checker

160 -- CACHE _p_alts for exhaustiveness checker

161+ -- CACHE _p_id for production code gen

160

162

161

163

162data PatternCtorArg =

164data PatternCtorArg =

src/Canonicalize/Environment.hs+2

@@ -25,6 +25,7 @@ import qualified AST.Canonical as Can

25import qualified AST.Module.Name as ModuleName

26import qualified Canonicalize.Result as Result

27import qualified Data.Bag as Bag

28+import qualified Data.Index as Index

28import qualified Data.OneOrMore as OneOrMore

29import qualified Data.OneOrMore as OneOrMore

29import qualified Elm.Name as N

30import qualified Elm.Name as N

30import qualified Reporting.Error.Canonicalize as Error

31import qualified Reporting.Error.Canonicalize as Error

@@ -100,6 +101,7 @@ data Pattern =

100 , _p_type :: N.Name

101 , _p_type :: N.Name

101 , _p_vars :: [N.Name]

102 , _p_vars :: [N.Name]

102 , _p_alts :: Can.CtorAlts

103 , _p_alts :: Can.CtorAlts

104+ , _p_index :: Index.ZeroBased

103 , _p_args :: [Can.Type]

105 , _p_args :: [Can.Type]

104 }

106 }

105

107

src/Canonicalize/Environment/Foreign.hs+4−3

@@ -15,6 +15,7 @@ import qualified AST.Module.Name as ModuleName

15import qualified Canonicalize.Environment as Env

16import qualified Canonicalize.Result as Result

17import qualified Data.Bag as Bag

18+import qualified Data.Index as Index

18import qualified Data.OneOrMore as OneOrMore

19import qualified Data.OneOrMore as OneOrMore

19import qualified Elm.Interface as I

20import qualified Elm.Interface as I

20import qualified Elm.Name as N

21import qualified Elm.Name as N

@@ -179,10 +180,10 @@ toPatterns home (tipe, Can.Union vars ctors) =

179 alts =

180 alts =

180 Can.ctorsToAlts ctors

181 Can.ctorsToAlts ctors

181

182

182− fromCtor (name, args) =

183+ fromCtor index (name, args) =

183− (name, Env.Pattern home tipe vars alts args)

184+ (name, Env.Pattern home tipe vars alts index args)

184 in

185 in

185− map fromCtor ctors

186+ Index.indexedMap fromCtor ctors

186

187

188

189

src/Canonicalize/Environment/Local.hs+9−5

@@ -21,6 +21,7 @@ import qualified Canonicalize.Environment.Dups as Dups

21import qualified Canonicalize.Result as Result

22import qualified Canonicalize.Type as Type

23import qualified Data.Bag as Bag

24+import qualified Data.Index as Index

24import qualified Elm.Name as N

25import qualified Elm.Name as N

25import qualified Reporting.Annotation as A

26import qualified Reporting.Annotation as A

26import qualified Reporting.Error.Canonicalize as Error

27import qualified Reporting.Error.Canonicalize as Error

@@ -86,10 +87,10 @@ addPatterns unions (Env.Env home vars types patterns binops) =

86 Map.fromList $ concatMap toPatterns (Map.toList unions)

87 Map.fromList $ concatMap toPatterns (Map.toList unions)

87

88

88 toPatterns (tipe, Can.Union tvars ctors) =

89 toPatterns (tipe, Can.Union tvars ctors) =

89− map (ctorToPattern tipe tvars (Can.ctorsToAlts ctors)) ctors

90+ Index.indexedMap (ctorToPattern tipe tvars (Can.ctorsToAlts ctors)) ctors

90

91

91− ctorToPattern tipe tvars alts (name, args) =

92+ ctorToPattern tipe tvars alts index (name, args) =

92− ( name, Env.Pattern home tipe tvars alts args )

93+ ( name, Env.Pattern home tipe tvars alts index args )

93 in

94 in

94 let

95 let

95 newPatterns =

96 newPatterns =

@@ -378,8 +379,11 @@ addFreeVars (A.At region tipe) freeVars =

378 Src.TType _ _ _ args ->

379 Src.TType _ _ _ args ->

379 foldr addFreeVars freeVars args

380 foldr addFreeVars freeVars args

380

381

381− Src.TRecord fields ext ->

382+ Src.TRecord fields Nothing ->

383+ foldr addFreeVars freeVars (map snd fields)

384+

385+ Src.TRecord fields (Just ext) ->

382− foldr addFreeVars (maybe id addFreeVars ext freeVars) (map snd fields)

386+ foldr addFreeVars (addFreeVars ext freeVars) (map snd fields)

383

387

384 Src.TUnit ->

388 Src.TUnit ->

385 freeVars

389 freeVars

src/Canonicalize/Pattern.hs+2−2

@@ -90,11 +90,11 @@ canonicalize env (A.At region pattern) =

90 Can.PatternCtorArg index tipe

91 <$> canonicalize env ptrn

92 in

93− do (Env.Pattern home tipe vars alts args) <- Env.findPattern nameRegion env maybePrefix name

93+ do (Env.Pattern home tipe vars alts index args) <- Env.findPattern nameRegion env maybePrefix name

94 verifiedList <- Index.indexedZipWithA toCanonicalArg patterns args

95 case verifiedList of

96 Index.LengthMatch cargs ->

97− Result.ok (Can.PCtor home tipe vars alts name cargs)

97+ Result.ok (Can.PCtor home tipe vars alts name index cargs)

98

99 Index.LengthMismatch actualLength expectedLength ->

100 Result.throw (error "TODO" region actualLength expectedLength)

src/Nitpick/PatternMatches.hs+3−3

@@ -70,7 +70,7 @@ simplify (A.At _ pattern) =

70 Can.PTuple a b (Just c) ->

71 Ctor tripleAlts tripleName [ simplify a, simplify b, simplify c ]

72

73− Can.PCtor _ _ _ alts name args ->

73+ Can.PCtor _ _ _ alts name _ args ->

74 Ctor alts name $

75 map (\(Can.PatternCtorArg _ _ arg) -> simplify arg) args

76

@@ -607,8 +607,8 @@ collectCtors matrix =

607collectCtorsHelp :: Map.Map N.Name Can.CtorAlts -> [Pattern] -> Map.Map N.Name Can.CtorAlts

608collectCtorsHelp ctors row =

609 case row of

610− Ctor info name _ : _ ->

610+ Ctor alts name _ : _ ->

611− Map.insert name info ctors

611+ Map.insert name alts ctors

612

613 _ ->

614 ctors

src/Type/Constrain/Pattern.hs+1−1

@@ -61,7 +61,7 @@ add (A.At region pattern) expectation state =

61 Can.PTuple a b maybeC ->

62 addTuple region a b maybeC expectation state

63

64− Can.PCtor home typeName typeVars _ ctorName args ->

64+ Can.PCtor home typeName typeVars _ ctorName _ args ->

65 addCtor region home typeName typeVars ctorName args expectation state

66

67 Can.PList patterns ->