@@ -105,14 +105,7 @@ constrain env (A.A region expression) tipe =
105 return (funcCon /\ argCon)
105 return (funcCon /\ argCon)
107 E.MultiIf branches ->
107 E.MultiIf branches ->
108− CAnd <$> mapM constrain' branches
108+ constrainIf env region branches tipe
110− bool = Env.get env Env.types "Bool"
112− constrain' (cond, expr) =
113− do cb <- constrain env cond bool
114− ce <- constrain env expr tipe
117 E.Case expr branches ->
110 E.Case expr branches ->
118 constrainCase env region expr branches tipe
111 constrainCase env region expr branches tipe
@@ -194,6 +187,59 @@ constrain env (A.A region expression) tipe =
194 constrain env expr tipe
187 constrain env expr tipe
190+-- CONSTRAIN IF EXPRESSIONS
195+ -> [(Canonical.Expr, Canonical.Expr)]
197+ -> IO TypeConstraint
198+constrainIf env region branches tipe =
199+ do (branchInfo, branchExprCons) <-
200+ unzip <$> mapM constrainBranch branches
203+ ex (map fst branchInfo)
204+ (CAnd (branchExprCons ++ branchCons branchInfo))
206+ bool = Env.get env Env.types "Bool"
208+ constrainBranch (cond, expr@(A.A branchRegion _)) =
209+ do branchVar <- variable Flexible
210+ condCon <- constrain env cond bool
211+ exprCon <- constrain env expr (varN branchVar)
213+ ( (branchVar, branchRegion)
214+ , condCon /\ exprCon
217+ branchCons branchInfo =
219+ [(thenVar, _), (elseVar, _)] ->
220+ [ CEqual Error.IfBranches region (varN thenVar) (varN elseVar)
221+ , CEqual Error.If region tipe (varN thenVar)
225+ buildBranchCons 2 branchInfo
227+ buildBranchCons n branchInfo =
233+ [ CEqual Error.If region tipe (varN var) ]
235+ (var,_) : (var',region') : rest ->
237+ hint = Error.MultiIfBranch n region'
238+ con = CEqual hint region (varN var) (varN var')
240+ con : buildBranchCons (n+1) ((var', region') : rest)
197-- CONSTRAIN CASE EXPRESSIONS
243-- CONSTRAIN CASE EXPRESSIONS
199constrainCase
245constrainCase