@@ -911,12 +911,13 @@ check' (TypedValue checkType val ty1) ty2 = do
911 kind <- liftCheck $ kindOf moduleName ty1
911 kind <- liftCheck $ kindOf moduleName ty1
912 guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
912 guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
913 ty1' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1
913 ty1' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1
914+ ty2' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty2
914− val' <- subsumes (Just val) ty1' ty2
915+ val' <- subsumes (Just val) ty1' ty2'
915 case val' of
916 case val' of
916 Nothing -> throwError . strMsg $ "Unable to check type subsumption"
917 Nothing -> throwError . strMsg $ "Unable to check type subsumption"
917 Just val'' -> do
918 Just val'' -> do
918− val''' <- if checkType then check val'' ty1' else return val''
919+ val''' <- if checkType then check val'' ty2' else return val''
919− return $ TypedValue checkType (TypedValue True val''' ty1) ty2
920+ return $ TypedValue checkType (TypedValue True val''' ty1') ty2'
920check' (Case vals binders) ret = do
921check' (Case vals binders) ret = do
921 vals' <- mapM infer vals
922 vals' <- mapM infer vals
922 let ts = map (\(TypedValue _ _ t) -> t) vals'
923 let ts = map (\(TypedValue _ _ t) -> t) vals'
@@ -1046,6 +1047,8 @@ checkFunctionApplication' fn (SaturatedTypeSynonym name tyArgs) arg ret = do
1046checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do
1047checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do
1047 dicts <- getTypeClassDictionaries
1048 dicts <- getTypeClassDictionaries
1048 checkFunctionApplication' (foldl App fn (map (flip (TypeClassDictionary True) dicts) constraints)) fnTy arg ret
1049 checkFunctionApplication' (foldl App fn (map (flip (TypeClassDictionary True) dicts) constraints)) fnTy arg ret
1050+checkFunctionApplication' fn fnTy dict@(TypeClassDictionary _ _ _) _ =
1051+ return (fnTy, App fn dict)
1049checkFunctionApplication' _ fnTy arg _ = throwError . strMsg $ "Cannot apply a function of type "
1052checkFunctionApplication' _ fnTy arg _ = throwError . strMsg $ "Cannot apply a function of type "
1050 ++ prettyPrintType fnTy
1053 ++ prettyPrintType fnTy
1051 ++ " to argument " ++ prettyPrintValue arg
1054 ++ " to argument " ++ prettyPrintValue arg