@@ -71,16 +71,19 @@ typesOf moduleName vals = do
7171 tys <- fmap tidyUp . liftUnifyWarnings replace $ do
7272 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals
7373 ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
74− ds2 <- forM untyped $ \e -> typeForBindingGroupElement True e dict untypedDict
74+ ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict
7575 return (map (\x -> (False, x)) ds1 ++ map (\x -> (True, x)) ds2)
7676
7777 forM tys $ \(shouldGeneralize, (ident, (val, ty))) -> do
7878 -- Replace type class dictionary placeholders with actual dictionaries
7979 (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize moduleName val
8080 let unsolvedTypeVars = nub $ unknownsInType ty
81+ -- Generalize and constrain the type
82+ let generalized = generalize unsolved ty
8183 -- Make sure any unsolved type constraints only use type variables which appear
8284 -- unknown in the inferred type.
83− when shouldGeneralize $
85+ when shouldGeneralize $ do
86+ tell . errorMessage $ MissingTypeDeclaration ident generalized
8487 forM_ unsolved $ \(_, (className, classTys)) -> do
8588 let constraintTypeVars = nub $ foldMap unknownsInType classTys
8689 when (any (`notElem` unsolvedTypeVars) constraintTypeVars) $
@@ -89,16 +92,17 @@ typesOf moduleName vals = do
8992 skolemEscapeCheck val'
9093 -- Check rows do not contain duplicate labels
9194 checkDuplicateLabels val'
92− return (ident, (foldr (Abs . Left . fst) val' unsolved, varIfUnknown (constrain unsolved ty)))
95+ return (ident, (foldr (Abs . Left . fst) val' unsolved, generalized))
9396 where
94− -- | Generalize over any unsolved constraints
97+ -- | Generalize type vars using forall and add inferred constraints
98+ generalize unsolved = varIfUnknown . constrain unsolved
99+ -- | Add any unsolved constraints
95100 constrain [] = id
96101 constrain cs = ConstrainedType (map snd cs)
97102 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
98103 tidyUp (ts, sub) = map (\(b, (i, (val, ty))) -> (b, (i, (overTypes (substituteType sub) val, substituteType sub ty)))) ts
99104 -- Replace all the wildcards types with their inferred types
100105 replace sub (ErrorMessage hints (WildcardInferredType ty)) = ErrorMessage hints . WildcardInferredType $ substituteType sub ty
101− replace sub (ErrorMessage hints (MissingTypeDeclaration name ty)) = ErrorMessage hints $ MissingTypeDeclaration name (varIfUnknown (substituteType sub ty))
102106 replace _ em = em
103107
104108type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
@@ -151,16 +155,14 @@ checkTypedBindingGroupElement mn (ident, (val', ty, checkType)) dict = do
151155
152156typeForBindingGroupElement ::
153157 (Functor m, Applicative m, MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
154− Bool ->
155158 (Ident, Expr) ->
156159 TypeData ->
157160 UntypedData ->
158161 m (Ident, (Expr, Type))
159−typeForBindingGroupElement warn (ident, val) dict untypedDict = do
162+typeForBindingGroupElement (ident, val) dict untypedDict = do
160163 -- Infer the type with the new names in scope
161164 TypedValue _ val' ty <- bindNames dict $ infer val
162165 unifyTypes ty $ fromMaybe (internalError "name not found in dictionary") (lookup ident untypedDict)
163− when warn . tell . errorMessage $ MissingTypeDeclaration ident ty
164166 return (ident, (TypedValue True val' ty, ty))
165167
166168-- | Check if a value contains a type annotation
@@ -343,7 +345,7 @@ inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do
343345 Just moduleName <- checkCurrentModule <$> get
344346 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)
345347 ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
346− ds2' <- forM untyped $ \e -> typeForBindingGroupElement False e dict untypedDict
348+ ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict
347349 let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']
348350 bindNames dict $ do
349351 makeBindingGroupVisible