a21661d · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Fix type generalizer bug

a21661dPhil Freeman13 years ago

purescript.cabal+1−1

compare with golang

unifiedsplit

@@ -1,5 +1,5 @@

1name: purescript

2−version: 0.1.12

2+version: 0.1.13

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

src/Language/PureScript/TypeChecker/Types.hs+38−8

@@ -23,8 +23,8 @@ import Data.Maybe (isJust, fromMaybe)

23import Data.Function

24import qualified Data.Data as D

25import Data.Generics

26− (something, everywhere, everywhereM, everything, everywhereBut,

26+ (extT, something, everywhere, everywhereM, everything,

27− mkT, mkM, mkQ, extM, extQ)

27+ everywhereBut, mkT, mkM, mkQ, extM, extQ)

29import Language.PureScript.Values

30import Language.PureScript.Types

@@ -196,7 +196,17 @@ setifyAll :: (D.Data d) => d -> d

196setifyAll = everywhere (mkT setify)

197

198varIfUnknown :: Type -> Type

199−varIfUnknown ty = mkForAll (sort . map ((:) 'u' . show) . nub $ unknowns ty) ty

199+varIfUnknown ty =

200+ let unks = nub $ unknowns ty

201+ toName = (:) 't' . show

202+ ty' = everywhere (mkT rowToVar) . everywhere (mkT typeToVar) $ ty

203+ typeToVar :: Type -> Type

204+ typeToVar (TUnknown (Unknown u)) = TypeVar (toName u)

205+ typeToVar t = t

206+ rowToVar :: Row -> Row

207+ rowToVar (RUnknown (Unknown u)) = RowVar (toName u)

208+ rowToVar t = t

209+ in mkForAll (sort . map toName $ unks) ty'

200

210

201replaceAllTypeVars :: (D.Data d) => [(String, Type)] -> d -> d

211replaceAllTypeVars :: (D.Data d) => [(String, Type)] -> d -> d

202replaceAllTypeVars = foldl' (\f (name, ty) -> replaceTypeVars name ty . f) id

212replaceAllTypeVars = foldl' (\f (name, ty) -> replaceTypeVars name ty . f) id

@@ -705,8 +715,8 @@ checkFunctionApplications :: M.Map Ident Type -> Type -> [[Value]] -> Type -> Su

705checkFunctionApplications _ _ [] _ = error "Nullary function application"

715checkFunctionApplications _ _ [] _ = error "Nullary function application"

706checkFunctionApplications m fnTy [args] ret = checkFunctionApplication m fnTy args ret

716checkFunctionApplications m fnTy [args] ret = checkFunctionApplication m fnTy args ret

707checkFunctionApplications m fnTy (args:argss) ret = do

717checkFunctionApplications m fnTy (args:argss) ret = do

708− f <- fresh

718+ argTys <- mapM (infer m) args

709− checkFunctionApplication m fnTy args f

719+ f <- inferFunctionApplication m fnTy argTys

710 checkFunctionApplications m f argss ret

720 checkFunctionApplications m f argss ret

711

721

712checkFunctionApplication :: M.Map Ident Type -> Type -> [Value] -> Type -> Subst Check ()

722checkFunctionApplication :: M.Map Ident Type -> Type -> [Value] -> Type -> Subst Check ()

@@ -718,6 +728,26 @@ checkFunctionApplication m fnTy args ret = rethrow errorMessage $ checkFunctionA

718 ++ ", expecting value of type "

728 ++ ", expecting value of type "

719 ++ prettyPrintType ret ++ ":\n" ++ msg

729 ++ prettyPrintType ret ++ ":\n" ++ msg

720

730

731+inferFunctionApplication :: M.Map Ident Type -> Type -> [Type] -> Subst Check Type

732+inferFunctionApplication m (Function argTys retTy) args = do

733+ guardWith "Incorrect number of function arguments" (length args == length argTys)

734+ zipWithM subsumes args argTys

735+ return retTy

736+inferFunctionApplication m (ForAll ident ty) args = do

737+ replaced <- replaceVarWithUnknown ident ty

738+ inferFunctionApplication m replaced args

739+inferFunctionApplication m u@(TUnknown _) args = do

740+ ret <- fresh

741+ args' <- mapM replaceAllVarsWithUnknowns args

742+ u ~~ Function args' ret

743+ return ret

744+inferFunctionApplication m (SaturatedTypeSynonym name tyArgs) args = do

745+ ty <- expandTypeSynonym name tyArgs

746+ inferFunctionApplication m ty args

747+inferFunctionApplication _ fnTy args = throwError $ "Cannot apply function of type "

748+ ++ prettyPrintType fnTy

749+ ++ " to argument(s) of type(s) " ++ intercalate ", " (map prettyPrintType args)

750+

721checkFunctionApplication' :: M.Map Ident Type -> Type -> [Value] -> Type -> Subst Check ()

751checkFunctionApplication' :: M.Map Ident Type -> Type -> [Value] -> Type -> Subst Check ()

722checkFunctionApplication' m (Function argTys retTy) args ret = do

752checkFunctionApplication' m (Function argTys retTy) args ret = do

723 guardWith "Incorrect number of function arguments" (length args == length argTys)

753 guardWith "Incorrect number of function arguments" (length args == length argTys)

@@ -732,10 +762,10 @@ checkFunctionApplication' m u@(TUnknown _) args ret = do

732checkFunctionApplication' m (SaturatedTypeSynonym name tyArgs) args ret = do

762checkFunctionApplication' m (SaturatedTypeSynonym name tyArgs) args ret = do

733 ty <- expandTypeSynonym name tyArgs

763 ty <- expandTypeSynonym name tyArgs

734 checkFunctionApplication' m ty args ret

764 checkFunctionApplication' m ty args ret

735−checkFunctionApplication' _ fnTy args ret = throwError $ "Cannot apply function of type "

765+checkFunctionApplication' _ fnTy args ret = throwError $ "Applying a function of type "

736 ++ prettyPrintType fnTy

766 ++ prettyPrintType fnTy

737− ++ " to arguments " ++ intercalate ", " (map prettyPrintValue args)

767+ ++ " to argument(s) " ++ intercalate ", " (map prettyPrintValue args)

738− ++ ". Expecting value of type " ++ prettyPrintType ret ++ "."

768+ ++ " does not yield a value of type " ++ prettyPrintType ret ++ "."

739

769

740subsumes :: Type -> Type -> Subst Check ()

770subsumes :: Type -> Type -> Subst Check ()

741subsumes (ForAll ident ty1) ty2 = do

771subsumes (ForAll ident ty1) ty2 = do