@@ -281,10 +281,10 @@ infer' (Case vals binders) = do
281 return $ TypedValue True (Case vals' binders') ret
281 return $ TypedValue True (Case vals' binders') ret
282infer' (IfThenElse cond th el) = do
282infer' (IfThenElse cond th el) = do
283 cond' <- check cond tyBoolean
283 cond' <- check cond tyBoolean
284− v2@(TypedValue _ _ t2) <- infer th
284+ th'@(TypedValue _ _ thTy) <- infer th
285− v3@(TypedValue _ _ t3) <- infer el
285+ el'@(TypedValue _ _ elTy) <- infer el
286− (v2', v3', t) <- meet v2 v3 t2 t3
286+ unifyTypes thTy elTy
287− return $ TypedValue True (IfThenElse cond' v2' v3') t
287+ return $ TypedValue True (IfThenElse cond' th' el') thTy
288infer' (Let ds val) = do
288infer' (Let ds val) = do
289 (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer
289 (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer
290 return $ TypedValue True (Let ds' val') valTy
290 return $ TypedValue True (Let ds' val') valTy
@@ -721,25 +721,6 @@ checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} _ =
721 return (fnTy, App fn dict)
721 return (fnTy, App fn dict)
722checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApplyFunction fnTy arg
722checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApplyFunction fnTy arg
724−-- | Compute the meet of two types, i.e. the most general type which both types subsume.
725−-- TODO: is this really needed?
727− (MonadState CheckState m, MonadError MultipleErrors m) =>
732− m (Expr, Expr, Type)
733−meet e1 e2 (ForAll ident t1 _) t2 = do
734− t1' <- replaceVarWithUnknown ident t1
736−meet e1 e2 t1 (ForAll ident t2 _) = do
737− t2' <- replaceVarWithUnknown ident t2
739−meet e1 e2 t1 t2 = do
744-- Ensure a set of property names and value does not contain duplicate labels
725-- Ensure a set of property names and value does not contain duplicate labels