@@ -67,24 +67,17 @@ import Language.PureScript.TypeChecker.Synonyms
6767import Language.PureScript.TypeChecker.Unify
6868import Language.PureScript.TypeClassDictionaries
6969import Language.PureScript.Types
70−import qualified Language.PureScript.Constants as C
7170
7271-- |
7372-- Infer the types of multiple mutually-recursive values, and return elaborated values including
7473-- type class dictionaries and type annotations.
7574--
76−typesOf :: Maybe ModuleName -> ModuleName -> [(Ident, Expr)] -> Check [(Ident, (Expr, Type))]
77−typesOf mainModuleName moduleName vals = do
75+typesOf :: ModuleName -> [(Ident, Expr)] -> Check [(Ident, (Expr, Type))]
76+typesOf moduleName vals = do
7877 tys <- fmap tidyUp . liftUnifyWarnings replace $ do
7978 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals
80− ds1 <- parU typed $ \e -> do
81− triple@(_, (_, ty)) <- checkTypedBindingGroupElement moduleName e dict
82− checkMain (fst e) ty
83− return triple
84− ds2 <- forM untyped $ \e -> do
85− triple@(_, (_, ty)) <- typeForBindingGroupElement e dict untypedDict
86− checkMain (fst e) ty
87− return triple
79+ ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
80+ ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict
8881 return $ ds1 ++ ds2
8982
9083 forM tys $ \(ident, (val, ty)) -> do
@@ -94,21 +87,13 @@ typesOf mainModuleName moduleName vals = do
9487 skolemEscapeCheck val'
9588 -- Check rows do not contain duplicate labels
9689 checkDuplicateLabels val'
97− -- Remove type synonyms placeholders, and replace
98− -- top-level unification variables with named type variables.
99− let val'' = overTypes desaturateAllTypeSynonyms val'
100− ty' = varIfUnknown . desaturateAllTypeSynonyms $ ty
101− return (ident, (val'', ty'))
90+ return (ident, (val', varIfUnknown ty))
10291 where
10392 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
10493 tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (sub $?) val, sub $? ty))) ts
10594 -- Replace all the wildcards types with their inferred types
10695 replace sub (SimpleErrorWrapper (WildcardInferredType ty)) = SimpleErrorWrapper $ WildcardInferredType (sub $? ty)
10796 replace _ em = em
108− -- If --main is enabled, need to check that `main` has type Eff eff a for some eff, a
109− checkMain nm ty = when (Just moduleName == mainModuleName && nm == Ident C.main) $ do
110− [eff, a] <- replicateM 2 fresh
111− ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Control", ProperName "Monad", ProperName "Eff"])) (ProperName "Eff"))) eff) a
11297
11398type TypeData = M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
11499
@@ -182,9 +167,7 @@ replaceTypeClassDictionaries mn =
182167 let (_, f, _) = everywhereOnValuesTopDownM return go return
183168 in f
184169 where
185− go (TypeClassDictionary constraint dicts) = do
186− env <- getEnv
187− entails env mn dicts constraint
170+ go (TypeClassDictionary constraint dicts) = entails mn dicts constraint
188171 go other = return other
189172
190173-- |
@@ -346,9 +329,6 @@ inferProperty :: Type -> String -> UnifyT Type Check (Maybe Type)
346329inferProperty (TypeApp obj row) prop | obj == tyObject = do
347330 let (props, _) = rowToList row
348331 return $ lookup prop props
349−inferProperty (SaturatedTypeSynonym name args) prop = do
350− replaced <- introduceSkolemScope <=< expandTypeSynonym name $ args
351− inferProperty replaced prop
352332inferProperty (ForAll ident ty _) prop = do
353333 replaced <- replaceVarWithUnknown ident ty
354334 inferProperty replaced prop
@@ -493,9 +473,6 @@ check' val t@(ConstrainedType constraints ty) = do
493473
494474 instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]
495475 instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs
496−check' val (SaturatedTypeSynonym name args) = do
497− ty <- introduceSkolemScope <=< expandTypeSynonym name $ args
498− check val ty
499476check' val u@(TUnknown _) = do
500477 val'@(TypedValue _ _ ty) <- infer val
501478 -- Don't unify an unknown with an inferred polytype
@@ -599,9 +576,6 @@ check' v@(Constructor c) ty = do
599576check' (Let ds val) ty = do
600577 (ds', val') <- inferLetBinding [] ds val (`check` ty)
601578 return $ TypedValue True (Let ds' val') ty
602−check' val ty | containsTypeSynonyms ty = do
603− ty' <- introduceSkolemScope <=< expandAllTypeSynonyms <=< replaceTypeWildcards $ ty
604− check val ty'
605579check' val kt@(KindedType ty kind) = do
606580 checkTypeKind ty kind
607581 val' <- check' val ty
@@ -615,12 +589,6 @@ check' val ty = do
615589 Nothing -> throwError . errorMessage $ SubsumptionCheckFailed
616590 Just v' -> return $ TypedValue True v' ty
617591
618−containsTypeSynonyms :: Type -> Bool
619−containsTypeSynonyms = everythingOnTypes (||) go where
620− go (SaturatedTypeSynonym _ _) = True
621− go _ = False
622−
623−
624592-- |
625593-- Check the type of a collection of named record fields
626594--
@@ -683,9 +651,6 @@ checkFunctionApplication' fn u@(TUnknown _) arg ret = do
683651 ret' <- maybe fresh return ret
684652 u =?= function ty ret'
685653 return (ret', App fn arg')
686−checkFunctionApplication' fn (SaturatedTypeSynonym name tyArgs) arg ret = do
687− ty <- introduceSkolemScope <=< expandTypeSynonym name $ tyArgs
688− checkFunctionApplication fn ty arg ret
689654checkFunctionApplication' fn (KindedType ty _) arg ret =
690655 checkFunctionApplication fn ty arg ret
691656checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do