ba585dc · rowtype-yoga/purescript-native

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

Add error for deep recursion in instance search, fix tests

commitba585dcba83ed9f09c65b6b3881b7688d557e83c authorPhil Freeman <paf31@cantab.net> dateThu 20 Aug 2015, 12:32 (11 years ago) parentf5d7b7f

3 files changed+9−19

compare with golang

unifiedsplit

src/Language/PureScript/Errors.hs+6−16 src/Language/PureScript/TypeChecker/Entailment.hs+2−2 src/Language/PureScript/TypeChecker/Types.hs+1−1

src/Language/PureScript/Errors.hs+6−16

@@ -40,7 +40,6 @@ import Language.PureScript.Pretty

4040import Language.PureScript.Types

4141import Language.PureScript.Names

4242import Language.PureScript.Kinds

43−import Language.PureScript.TypeClassDictionaries

4443

4544import qualified Text.PrettyPrint.Boxes as Box

4645

@@ -108,8 +107,9 @@ data SimpleErrorMessage

108107 | TypesDoNotUnify Type Type

109108 | KindsDoNotUnify Kind Kind

110109 | ConstrainedTypeUnified Type Type

111− | OverlappingInstances (Qualified ProperName) [Type] [DictionaryValue]

110+ | OverlappingInstances (Qualified ProperName) [Type] [Qualified Ident]

112111 | NoInstanceFound (Qualified ProperName) [Type]

112+ | PossiblyInfiniteInstance (Qualified ProperName) [Type]

113113 | CannotDerive (Qualified ProperName) [Type]

114114 | CannotFindDerivingType ProperName

115115 | DuplicateLabel String (Maybe Expr)

@@ -233,6 +233,7 @@ errorCode em = case unwrapErrorMessage em of

233233 ConstrainedTypeUnified{} -> "ConstrainedTypeUnified"

234234 OverlappingInstances{} -> "OverlappingInstances"

235235 NoInstanceFound{} -> "NoInstanceFound"

236+ PossiblyInfiniteInstance{} -> "PossiblyInfiniteInstance"

236237 CannotDerive{} -> "CannotDerive"

237238 CannotFindDerivingType{} -> "CannotFindDerivingType"

238239 DuplicateLabel{} -> "DuplicateLabel"

@@ -544,10 +545,12 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

544545 ]

545546 goSimple (OverlappingInstances nm ts ds) =

546547 paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"

547− , paras $ map prettyPrintDictionaryValue ds

548+ , line $ intercalate ", " (map show ds)

548549 ]

549550 goSimple (NoInstanceFound nm ts) =

550551 line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)

552+ goSimple (PossiblyInfiniteInstance nm ts) =

553+ line $ "Instance for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ " is possibly infinite."

551554 goSimple (CannotDerive nm ts) =

552555 line $ "Cannot derive " ++ show nm ++ " instance for " ++ unwords (map prettyPrintTypeAtom ts)

553556 goSimple (CannotFindDerivingType nm) =

@@ -736,19 +739,6 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

736739 indent :: Box.Box -> Box.Box

737740 indent = Box.moveRight 2

738741

739− -- |

740− -- Render a DictionaryValue fit for human consumption in error messages

741− --

742− prettyPrintDictionaryValue :: DictionaryValue -> Box.Box

743− prettyPrintDictionaryValue (LocalDictionaryValue _) = line "Dictionary in scope"

744− prettyPrintDictionaryValue (GlobalDictionaryValue nm) = line (show nm)

745− prettyPrintDictionaryValue (DependentDictionaryValue nm args) = paras [ line $ (show nm) ++ " via"

746− , indent $ paras $ map prettyPrintDictionaryValue args

747− ]

748− prettyPrintDictionaryValue (SubclassDictionaryValue sup nm _) = paras [ line $ (show nm) ++ " via superclass"

749− , indent $ prettyPrintDictionaryValue sup

750− ]

751−

752742 -- |

753743 -- Pretty print and export declaration

754744 --

src/Language/PureScript/TypeChecker/Entailment.hs+2−2

@@ -60,7 +60,7 @@ entails env moduleName context = solve

6060 return $ dictionaryValueToValue dict

6161 where

6262 go :: Int -> Qualified ProperName -> [Type] -> Check DictionaryValue

63− go work _ _ | work > 1000 = error "Overworked!"

63+ go work className' tys' | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'

6464 go work className' tys' = do

6565 let instances = do

6666 tcd <- forClassName className'

@@ -78,7 +78,7 @@ entails env moduleName context = solve

7878 unique :: [(a, TypeClassDictionaryInScope)] -> Check (a, TypeClassDictionaryInScope)

7979 unique [] = throwError . errorMessage $ NoInstanceFound className' tys'

8080 unique [a] = return a

81− unique xs@(x : _) | pairwise overlapping (map snd xs) = throwError . errorMessage $ OverlappingInstances className' tys' [] -- include overlaps in error, use simplest instance

81+ unique xs@(x : _) | pairwise overlapping (map snd xs) = throwError . errorMessage $ OverlappingInstances className' tys' (map (tcdName . snd) xs) -- TODO: use simplest instance

8282 | otherwise = return x

8383

8484 -- |

src/Language/PureScript/TypeChecker/Types.hs+1−1

@@ -467,7 +467,7 @@ check' val t@(ConstrainedType constraints ty) = do

467467 return (TypeClassDictionaryInScope name path className instanceTy Nothing TCDRegular : supDicts)

468468

469469 instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]

470− instantiateSuperclass args supArgs tys = traceShow (args, supArgs, tys) $ map (replaceAllTypeVars (zip args tys)) supArgs

470+ instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs

471471check' val (SaturatedTypeSynonym name args) = do

472472 ty <- introduceSkolemScope <=< expandTypeSynonym name $ args

473473 check val ty