git.iko.soy/elk
on master help sign in
No environment necessary when constraining patterns
1762552Evan Czaplicki
src/Type/Constrain/Pattern.hs+20−24
compare with master
unifiedsplit
@@ -26,13 +26,10 @@ import Type.Type
26-- CONSTRAIN PATTERN
26-- CONSTRAIN PATTERN
27
27
28
28
29−type Env = ()
30−
31−
32−constrain :: Env -> Can.Pattern -> Type -> IO (Map.Map N.Name (A.Located Type), [Variable], Constraint)
29+constrain :: Can.Pattern -> Type -> IO (Map.Map N.Name (A.Located Type), [Variable], Constraint)
33−constrain env pattern tipe =
30+constrain pattern tipe =
34 do (Info headers vars cons) <-
31 do (Info headers vars cons) <-
35− addConstraints env Error.PatternUnknown pattern tipe $
32+ addConstraints Error.PatternUnknown pattern tipe $
36 Info Map.empty Bag.empty []
33 Info Map.empty Bag.empty []
37
34
38 return ( headers, Bag.toList vars, CAnd (reverse cons) )
35 return ( headers, Bag.toList vars, CAnd (reverse cons) )
@@ -50,8 +47,8 @@ data Info =
50 }
47 }
51
48
52
49
53−addConstraints :: Env -> Error.PatternContext -> Can.Pattern -> Type -> Info -> IO Info
50+addConstraints :: Error.PatternContext -> Can.Pattern -> Type -> Info -> IO Info
54−addConstraints env context (A.A region pattern) tipe info =
51+addConstraints context (A.A region pattern) tipe info =
55 case pattern of
52 case pattern of
56 Can.PAnything ->
53 Can.PAnything ->
57 return info
54 return info
@@ -68,7 +65,7 @@ addConstraints env context (A.A region pattern) tipe info =
68
65
69 Can.PAlias realPattern name ->
66 Can.PAlias realPattern name ->
70 do let (Info headers vars revCons) = info
67 do let (Info headers vars revCons) = info
71− addConstraints env context realPattern tipe $
68+ addConstraints context realPattern tipe $
72 Info (Map.insert name (A.A region tipe) headers) vars revCons
69 Info (Map.insert name (A.A region tipe) headers) vars revCons
73
70
74 Can.PUnit ->
71 Can.PUnit ->
@@ -77,13 +74,13 @@ addConstraints env context (A.A region pattern) tipe info =
77 return $ Info headers vars (unitCon:revCons)
74 return $ Info headers vars (unitCon:revCons)
78
75
79 Can.PTuple a b maybeC ->
76 Can.PTuple a b maybeC ->
80− addTupleConstraint env context region a b maybeC tipe info
77+ addTupleConstraint context region a b maybeC tipe info
81
78
82 Can.PCtor home typeName vs ctorName args ->
79 Can.PCtor home typeName vs ctorName args ->
83 do (Instantiate.Ctor tvars targs ttype) <- Instantiate.pattern home typeName vs args
80 do (Instantiate.Ctor tvars targs ttype) <- Instantiate.pattern home typeName vs args
84
81
85 (Info headers vars revCons) <-
82 (Info headers vars revCons) <-
86− foldM (addCtorConstraint env ctorName) info targs
83+ foldM (addCtorConstraint ctorName) info targs
87
84
88 return $
85 return $
89 Info
86 Info
@@ -101,7 +98,7 @@ addConstraints env context (A.A region pattern) tipe info =
101
98
102 (Info headers vars revCons) <-
99 (Info headers vars revCons) <-
103 foldM
100 foldM
104− (addListConstraint env entryVarN)
101+ (addListConstraint entryVarN)
105 info
102 info
106 (zip patterns [ 1 .. length patterns ])
103 (zip patterns [ 1 .. length patterns ])
107
104
@@ -116,8 +113,8 @@ addConstraints env context (A.A region pattern) tipe info =
116 let tailType = AppN ModuleName.list N.list [tailVarN]
113 let tailType = AppN ModuleName.list N.list [tailVarN]
117
114
118 (Info headers vars revCons) <-
115 (Info headers vars revCons) <-
119− addConstraints env Error.PatternTail tailPattern tailType =<<
116+ addConstraints Error.PatternTail tailPattern tailType =<<
120− addConstraints env Error.PatternUnknown headPattern headVarN info
117+ addConstraints Error.PatternUnknown headPattern headVarN info
121
118
122 return $
119 return $
123 Info
120 Info
@@ -154,18 +151,18 @@ addConstraints env context (A.A region pattern) tipe info =
154-- CONSTRAIN CONSTRUCTORS
151-- CONSTRAIN CONSTRUCTORS
155
152
156
153
157−addCtorConstraint :: Env -> N.Name -> Info -> (Int, Type, Can.Pattern) -> IO Info
154+addCtorConstraint :: N.Name -> Info -> (Int, Type, Can.Pattern) -> IO Info
158−addCtorConstraint env name info (index, argType, argPattern) =
155+addCtorConstraint name info (index, argType, argPattern) =
159− addConstraints env (Error.PatternArg name index) argPattern argType info
156+ addConstraints (Error.PatternArg name index) argPattern argType info
160
157
161
158
162
159
163-- CONSTRAIN LIST
160-- CONSTRAIN LIST
164
161
165
162
166−addListConstraint :: Env -> Type -> Info -> (Can.Pattern, Int) -> IO Info
163+addListConstraint :: Type -> Info -> (Can.Pattern, Int) -> IO Info
167−addListConstraint env tipe info (pattern, index) =
164+addListConstraint tipe info (pattern, index) =
168− addConstraints env (Error.PatternList index) pattern tipe info
165+ addConstraints (Error.PatternList index) pattern tipe info
169
166
170
167
171
168
@@ -173,8 +170,7 @@ addListConstraint env tipe info (pattern, index) =
173
170
174
171
175addTupleConstraint
172addTupleConstraint
176− :: Env
177− -> Error.PatternContext
173+ :: Error.PatternContext
178 -> R.Region
174 -> R.Region
179 -> Can.Pattern
175 -> Can.Pattern
180 -> Can.Pattern
176 -> Can.Pattern
@@ -182,9 +178,9 @@ addTupleConstraint
182 -> Type
178 -> Type
183 -> Info
179 -> Info
184 -> IO Info
180 -> IO Info
185−addTupleConstraint env context region a b maybeC tipe (Info headers vars revCons) =
181+addTupleConstraint context region a b maybeC tipe (Info headers vars revCons) =
186 do let equal = CEqual (Error.Pattern context Error.PTuple) region
182 do let equal = CEqual (Error.Pattern context Error.PTuple) region
187− let addCon = addConstraints env Error.PatternUnknown
183+ let addCon = addConstraints Error.PatternUnknown
188
184
189 aVar <- mkFlexVar
185 aVar <- mkFlexVar
190 bVar <- mkFlexVar
186 bVar <- mkFlexVar