Commit b22b7df4 authored by Jan-Hendrik Matthes's avatar Jan-Hendrik Matthes 😄

Migrate the typeScheme function into the polyType function

parent c110704e
......@@ -39,7 +39,7 @@ module Base.Types
, ClassMethod (..)
, methodName, methodArity, methodType
-- * Representation of quantification
, monoType, polyType, typeScheme, rawType, rawPredType
, monoType, polyType, rawType, rawPredType
-- * Predefined types
, arrowType, unitType, predUnitType, boolType, predBoolType, charType
, intType, predIntType, floatType, predFloatType, stringType, predStringType
......@@ -54,6 +54,8 @@ import Curry.Base.Ident
import Base.Messages (internalError)
import Env.Class (ClassEnv, allSuperClasses)
import Data.List (nub)
-- -----------------------------------------------------------------------------
-- Types
-- -----------------------------------------------------------------------------
......@@ -395,11 +397,7 @@ monoType = TypeForall []
-- universally quantified type variables in the type are assigned indices
-- starting with 0 and does not renumber the variables.
polyType :: Type -> Type
polyType = typeScheme
-- | Translates a type into a type scheme.
typeScheme :: Type -> Type
typeScheme ty = TypeForall (typeVars ty) ty
polyType ty = TypeForall (filter (>= 0) (nub $ typeVars ty)) ty
-- | Strips the quantifier and predicate set from a type scheme.
rawType :: Type -> Type
......
......@@ -404,7 +404,7 @@ bindClassMethods' m tcEnv vEnv
bindClassMethod :: ModuleIdent -> ClassMethod -> ValueEnv -> ValueEnv
bindClassMethod m (ClassMethod f _ ty) =
bindGlobalInfo (\qc tySc -> Value qc True 0 tySc) m f (typeScheme ty)
bindGlobalInfo (\qc tySc -> Value qc True 0 tySc) m f (polyType ty)
-- -----------------------------------------------------------------------------
-- Default Types
......@@ -416,7 +416,7 @@ bindClassMethod m (ClassMethod f _ ty) =
setDefaults :: Decl a -> TCM ()
setDefaults (DefaultDecl _ tys) = mapM toDefaultType tys >>= setDefaultTypes
where
toDefaultType ty = snd <$> (inst =<< typeScheme <$> expandTypeExpr ty)
toDefaultType ty = snd <$> (inst =<< polyType <$> expandTypeExpr ty)
setDefaults _ = ok
-- -----------------------------------------------------------------------------
......@@ -539,7 +539,7 @@ tcDeclVars (FunctionDecl _ _ f eqs) = do
case lookupTypeSig f sigs of
Just ty -> do
ty' <- expandTypeExpr ty
return [(f, n, typeScheme ty')]
return [(f, n, polyType ty')]
Nothing -> do
tys <- replicateM (n + 1) freshTypeVar
return [(f, n, monoType $ foldr1 TypeArrow tys)]
......@@ -553,7 +553,7 @@ tcDeclVar poly v = do
sigs <- getSigEnv
case lookupTypeSig v sigs of
Just ty | poly || null (fv ty) -> do ty' <- expandTypeExpr ty
return (v, 0, typeScheme ty')
return (v, 0, polyType ty')
| otherwise -> do report $ errPolymorphicVar v
lambdaVar v
Nothing -> lambdaVar v
......@@ -706,16 +706,12 @@ fixType _ _ = internalError "TypeCheck.fixType"
declVars :: Decl Type -> [(Ident, Int, Type)]
declVars (FunctionDecl _ ty f eqs)
= [(f, eqnArity $ head eqs, typeSchemeFixed ty)]
= [(f, eqnArity $ head eqs, polyType ty)]
declVars (PatternDecl _ t _) = case t of
VariablePattern _ ty v -> [(v, 0, typeSchemeFixed ty)]
VariablePattern _ ty v -> [(v, 0, polyType ty)]
_ -> []
declVars _ = internalError "TypeCheck.declVars"
-- | Quantifies type variables that are greater than or equal to zero.
typeSchemeFixed :: Type -> Type
typeSchemeFixed ty = TypeForall (filter (>= 0) (typeVars ty)) ty
-- The function 'tcCheckPDecl' checks the type of an explicitly typed function
-- or variable declaration. After inferring a type for the declaration, the
-- inferred type is compared with the type signature. Since the inferred type of
......@@ -992,7 +988,7 @@ toClassMethodTypeExpr qcls clsvar ty
tcInstanceMethodPDecl :: QualIdent -> Type -> PDecl a -> TCM (PDecl Type)
tcInstanceMethodPDecl qcls pty pd@(_, FunctionDecl _ _ f _) = do
methTy <- instMethodType (qualifyLike qcls) pty f
(tySc, pd') <- tcMethodPDecl (typeScheme methTy) pd
(tySc, pd') <- tcMethodPDecl (polyType methTy) pd
checkInstMethodType (normalize 0 methTy) tySc pd'
tcInstanceMethodPDecl _ _ _ = internalError "TypeCheck.tcInstanceMethodPDecl"
......@@ -1213,7 +1209,7 @@ tcExpr cm p (Paren spi e) = do
return (ps, ty, Paren spi e')
tcExpr _ p (Typed spi e qty) = do
pty <- expandTypeExpr qty
(ps, ty) <- inst (typeScheme pty)
(ps, ty) <- inst (polyType pty)
(ps', e') <- tcExpr (Check ty) p e >>-
unifyDecl p "explicitly typed expression" (ppExpr 0 e) emptyPredSet ty
fvs <- computeFvEnv
......
......@@ -205,4 +205,4 @@ bindLocalVars = flip $ foldr bindLocalVar
bindLocalVar :: ValueType t => (Ident, Int, t) -> ValueEnv -> ValueEnv
bindLocalVar (v, a, ty) =
bindTopEnv v $ Value (qualify v) False a $ typeScheme $ fromValueType ty
bindTopEnv v $ Value (qualify v) False a $ polyType $ fromValueType ty
......@@ -263,9 +263,9 @@ values m (INewtypeDecl _ tc _ tvs nc hs) =
where tc' = qualQualify m tc
ty' = constrType tc' tvs
values m (IFunctionDecl _ f Nothing a qty) =
[Value (qualQualify m f) False a (typeScheme (toQualPredType m [] qty))]
[Value (qualQualify m f) False a (polyType (toQualPredType m [] qty))]
values m (IFunctionDecl _ f (Just tv) _ qty) =
[Value (qualQualify m f) True 0 (typeScheme (toQualPredType m [tv] qty))]
[Value (qualQualify m f) True 0 (polyType (toQualPredType m [tv] qty))]
values m (IClassDecl _ _ qcls _ tv ds hs) =
map (classMethod m qcls' tv) (filter ((`notElem` hs) . imethod) ds)
where qcls' = qualQualify m qcls
......@@ -316,7 +316,7 @@ constrType tc tvs = foldl (ApplyType NoSpanInfo) (ConstructorType NoSpanInfo tc)
classMethod :: ModuleIdent -> QualIdent -> Ident -> IMethodDecl -> ValueInfo
classMethod m qcls tv (IMethodDecl _ f _ qty) =
Value (qualifyLike qcls f) True 0 $
typeScheme $ qualifyType m $ toMethodType qcls tv qty
polyType $ qualifyType m $ toMethodType qcls tv qty
-- ---------------------------------------------------------------------------
......
......@@ -634,7 +634,7 @@ bindInstMethod m cls ty m' ps is f vEnv = bindMethod m f' a pty vEnv
bindMethod :: ModuleIdent -> QualIdent -> Int -> Type -> ValueEnv
-> ValueEnv
bindMethod m f n pty = bindEntity m f $ Value f False n $ typeScheme pty
bindMethod m f n pty = bindEntity m f $ Value f False n $ polyType pty
-- The function 'bindEntity' introduces a binding for an entity into a top-level
-- environment. Depending on whether the entity is defined in the current module
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment