@@ -237,34 +237,17 @@ constrainList env region exprs tipe =
237237 do (exprInfo, exprCons) <-
238238 unzip <$> mapM elementConstraint exprs
239239
240− let pairwiseCons = pairwiseConstraints 2 exprInfo
240+ (vars, cons) <- pairCons region Error.ListElement varToCon exprInfo
241241
242− return $
243− ex (map fst exprInfo)
244− (CAnd (exprCons ++ pairwiseCons))
242+ return $ ex vars (CAnd (exprCons ++ cons))
245243 where
246− list t =
247− Env.get env Env.types "List" <| t
248−
249244 elementConstraint expr@(A.A region' _) =
250245 do var <- variable Flexible
251246 con <- constrain env expr (varN var)
252247 return ( (var, region'), con )
253248
254− pairwiseConstraints n exprInfo =
255− case exprInfo of
256− [] ->
257− []
258−
259− (var,_) : [] ->
260− [ CEqual Error.List region tipe (list (varN var)) ]
261−
262− (var,_) : (var',region') : rest ->
263− let
264− hint = Error.ListElement n region'
265− con = CEqual hint region (varN var) (varN var')
266− in
267− con : pairwiseConstraints (n+1) ((var', region') : rest)
249+ varToCon var =
250+ CEqual Error.List region tipe (Env.get env Env.types "List" <| varN var)
268251
269252
270253-- CONSTRAIN IF EXPRESSIONS
@@ -279,9 +262,9 @@ constrainIf env region branches tipe =
279262 do (branchInfo, branchExprCons) <-
280263 unzip <$> mapM constrainBranch branches
281264
282− return $
283− ex (map fst branchInfo)
284− (CAnd (branchExprCons ++ branchCons branchInfo))
265+ (vars,cons) <- branchCons branchInfo
266+
267+ return $ ex vars (CAnd (branchExprCons ++ cons))
285268 where
286269 bool = Env.get env Env.types "Bool"
287270
@@ -297,27 +280,18 @@ constrainIf env region branches tipe =
297280 branchCons branchInfo =
298281 case branchInfo of
299282 [(thenVar, _), (elseVar, _)] ->
300− [ CEqual Error.IfBranches region (varN thenVar) (varN elseVar)
301− , CEqual Error.If region tipe (varN thenVar)
302− ]
283+ return
284+ ( [thenVar,elseVar]
285+ , [ CEqual Error.IfBranches region (varN thenVar) (varN elseVar)
286+ , varToCon thenVar
287+ ]
288+ )
303289
304290 _ ->
305− buildBranchCons 2 branchInfo
306−
307− buildBranchCons n branchInfo =
308− case branchInfo of
309− [] ->
310− []
291+ pairCons region Error.MultiIfBranch varToCon branchInfo
311292
312− (var,_) : [] ->
313− [ CEqual Error.If region tipe (varN var) ]
314−
315− (var,_) : (var',region') : rest ->
316− let
317− hint = Error.MultiIfBranch n region'
318− con = CEqual hint region (varN var) (varN var')
319− in
320− con : buildBranchCons (n+1) ((var', region') : rest)
293+ varToCon var =
294+ CEqual Error.If region tipe (varN var)
321295
322296
323297-- CONSTRAIN CASE EXPRESSIONS
@@ -331,15 +305,14 @@ constrainCase
331305 -> IO TypeConstraint
332306constrainCase env region expr branches tipe =
333307 do exprVar <- variable Flexible
334−
335308 exprCon <- constrain env expr (varN exprVar)
336309
337310 (branchInfo, branchExprCons) <-
338311 unzip <$> mapM (branch (varN exprVar)) branches
339312
340− return $
341− ex (exprVar : map fst branchInfo)
342− (CAnd (exprCon : branchExprCons ++ branchCons 2 branchInfo))
313+ (vars, cons) <- pairCons region Error.CaseBranch varToCon branchInfo
314+
315+ return $ ex (exprVar : vars) (CAnd (exprCon : branchExprCons ++ cons))
343316 where
344317 branch patternType (pattern, branchExpr@(A.A branchRegion _)) =
345318 do branchVar <- variable Flexible
@@ -350,20 +323,52 @@ constrainCase env region expr branches tipe =
350323 , CLet [Fragment.toScheme fragment] branchCon
351324 )
352325
353− branchCons n branchInfo =
354− case branchInfo of
355− [] ->
356− []
326+ varToCon var =
327+ CEqual Error.Case region tipe (varN var)
357328
358− (var,_) : [] ->
359− [ CEqual Error.Case region tipe (varN var) ]
360329
361− (var,_) : (var',region') : rest ->
362− let
363− hint = Error.CaseBranch n region'
364− con = CEqual hint region (varN var) (varN var')
365− in
366− con : branchCons (n+1) ((var', region') : rest)
330+-- COLLECT PAIRS
331+
332+data Pair = Pair
333+ { _index :: Int
334+ , _var1 :: Variable
335+ , _var2 :: Variable
336+ , _region :: R.Region
337+ }
338+
339+
340+pairCons
341+ :: R.Region
342+ -> (Int -> R.Region -> Error.Hint)
343+ -> (Variable -> TypeConstraint)
344+ -> [(Variable, R.Region)]
345+ -> IO ([Variable], [TypeConstraint])
346+pairCons region pairHint varToCon items =
347+ let
348+ pairToCon (Pair index var1 var2 subregion) =
349+ CEqual (pairHint index subregion) region (varN var1) (varN var2)
350+ in
351+ case collectPairs 2 items of
352+ Nothing ->
353+ do var <- variable Flexible
354+ return ([var], [varToCon var])
355+
356+ Just (pairs, var) ->
357+ return (map fst items, map pairToCon pairs ++ [varToCon var])
358+
359+
360+collectPairs :: Int -> [(Variable, R.Region)] -> Maybe ([Pair], Variable)
361+collectPairs index items =
362+ case items of
363+ [] ->
364+ Nothing
365+
366+ (var,_) : [] ->
367+ Just ([], var)
368+
369+ (var,_) : rest@((var',region) : _) ->
370+ do (pairs, summaryVar) <- collectPairs (index+1) rest
371+ return (Pair index var var' region : pairs, summaryVar)
367372
368373
369374-- EXPAND PATTERNS