Commit 23075169 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Mainly, rename LiteralTy to LitTy

parent 85926ae6
......@@ -1097,7 +1097,7 @@ getTyDescription ty
FunTy _ res -> '-' : '>' : fun_result res
TyConApp tycon _ -> getOccString tycon
ForAllTy _ ty -> getTyDescription ty
LiteralTy n -> getTyLitDescription n
LitTy n -> getTyLitDescription n
}
where
fun_result (FunTy _ res) = '>' : fun_result res
......
......@@ -864,7 +864,7 @@ getTyDescription ty
FunTy _ res -> '-' : '>' : fun_result res
TyConApp tycon _ -> getOccString tycon
ForAllTy _ ty -> getTyDescription ty
LiteralTy n -> getTyLitDescription n
LitTy n -> getTyLitDescription n
}
where
fun_result (FunTy _ res) = '>' : fun_result res
......
......@@ -846,7 +846,7 @@ lintType ty@(TyConApp tc tys)
| otherwise
= failWithL (hang (ptext (sLit "Malformed type:")) 2 (ppr ty))
lintType ty@(LiteralTy l) = lintTyLit l >> return (typeKind ty)
lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty)
lintType (ForAllTy tv ty)
= do { lintTyBndrKind tv
......
......@@ -216,11 +216,12 @@ make_ty t = make_ty' t
-- note calls to make_ty so as to expand types recursively
make_ty' :: Type -> C.Ty
make_ty' (TyVarTy tv) = C.Tvar (make_var_id (tyVarName tv))
make_ty' (AppTy t1 t2) = C.Tapp (make_ty t1) (make_ty t2)
make_ty' (FunTy t1 t2) = make_ty (TyConApp funTyCon [t1,t2])
make_ty' (ForAllTy tv t) = C.Tforall (make_tbind tv) (make_ty t)
make_ty' (TyConApp tc ts) = make_tyConApp tc ts
make_ty' (TyVarTy tv) = C.Tvar (make_var_id (tyVarName tv))
make_ty' (AppTy t1 t2) = C.Tapp (make_ty t1) (make_ty t2)
make_ty' (FunTy t1 t2) = make_ty (TyConApp funTyCon [t1,t2])
make_ty' (ForAllTy tv t) = C.Tforall (make_tbind tv) (make_ty t)
make_ty' (TyConApp tc ts) = make_tyConApp tc ts
make_ty' (LitTy {}) = panic "MkExernalCore can't do literal types yet"
-- Newtypes are treated just like any other type constructor; not expanded
-- Reason: predTypeRep does substitution and, while substitution deals
......
......@@ -523,7 +523,7 @@ lkT env ty m
go (AppTy t1 t2) = tm_app >.> lkT env t1 >=> lkT env t2
go (FunTy t1 t2) = tm_fun >.> lkT env t1 >=> lkT env t2
go (TyConApp tc tys) = tm_tc_app >.> lkNamed tc >=> lkList (lkT env) tys
go (LiteralTy l) = tm_tylit >.> lkTyLit l
go (LitTy l) = tm_tylit >.> lkTyLit l
go (ForAllTy tv ty) = tm_forall >.> lkT (extendCME env tv) ty >=> lkBndr env tv
-----------------
......@@ -539,8 +539,7 @@ xtT env (ForAllTy tv ty) f m = m { tm_forall = tm_forall m |> xtT (extendCME e
|>> xtBndr env tv f }
xtT env (TyConApp tc tys) f m = m { tm_tc_app = tm_tc_app m |> xtNamed tc
|>> xtList (xtT env) tys f }
xtT _ (LiteralTy l) f m = m { tm_tylit = tm_tylit m |> xtTyLit l f }
xtT _ (LitTy l) f m = m { tm_tylit = tm_tylit m |> xtTyLit l f }
fdT :: (a -> b -> b) -> TypeMap a -> b -> b
fdT _ EmptyTM = \z -> z
......
......@@ -1037,7 +1037,7 @@ instance Binary IfaceType where
put_ bh (IfaceTyConApp tc tys)
= do { putByte bh 21; put_ bh tc; put_ bh tys }
put_ bh (IfaceLiteralTy n)
put_ bh (IfaceLitTy n)
= do { putByte bh 30; put_ bh n }
......@@ -1081,7 +1081,7 @@ instance Binary IfaceType where
; return (IfaceTyConApp tc tys) }
30 -> do n <- get bh
return (IfaceLiteralTy n)
return (IfaceLitTy n)
_ -> panic ("get IfaceType " ++ show h)
......
......@@ -795,7 +795,7 @@ freeNamesIfType (IfaceTyVar _) = emptyNameSet
freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
freeNamesIfType (IfaceTyConApp tc ts) =
freeNamesIfTc tc &&& fnList freeNamesIfType ts
freeNamesIfType (IfaceLiteralTy _) = emptyNameSet
freeNamesIfType (IfaceLitTy _) = emptyNameSet
freeNamesIfType (IfaceForAllTy tv t) =
freeNamesIfTvBndr tv &&& freeNamesIfType t
freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
......
......@@ -84,7 +84,7 @@ data IfaceType -- A kind of universal type, used for types, kinds, and coerci
| IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
-- Includes newtypes, synonyms, tuples
| IfaceCoConApp IfaceCoCon [IfaceType] -- Always saturated
| IfaceLiteralTy IfaceTyLit
| IfaceLitTy IfaceTyLit
type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]
......@@ -246,7 +246,7 @@ ppr_ty :: Int -> IfaceType -> SDoc
ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
ppr_ty _ (IfaceLiteralTy n) = ppr_tylit n
ppr_ty _ (IfaceLitTy n) = ppr_tylit n
ppr_ty ctxt_prec (IfaceCoConApp tc tys)
= maybeParen ctxt_prec tYCON_PREC
......@@ -375,7 +375,7 @@ toIfaceType (TyVarTy tv) = IfaceTyVar (toIfaceTyVar tv)
toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (FunTy t1 t2) = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
toIfaceType (LiteralTy n) = IfaceLiteralTy (toIfaceTyLit n)
toIfaceType (LitTy n) = IfaceLitTy (toIfaceTyLit n)
toIfaceType (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
toIfaceTyVar :: TyVar -> FastString
......
......@@ -827,7 +827,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
tcIfaceType :: IfaceType -> IfL Type
tcIfaceType (IfaceTyVar n) = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
tcIfaceType (IfaceAppTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
tcIfaceType (IfaceLiteralTy l) = do { l1 <- tcIfaceTyLit l; return (LiteralTy l1) }
tcIfaceType (IfaceLitTy l) = do { l1 <- tcIfaceTyLit l; return (LitTy l1) }
tcIfaceType (IfaceFunTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
tcIfaceType (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
......@@ -857,7 +857,7 @@ tcIfaceCo (IfaceTyVar n) = mkCoVarCo <$> tcIfaceCoVar n
tcIfaceCo (IfaceAppTy t1 t2) = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
tcIfaceCo (IfaceFunTy t1 t2) = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
tcIfaceCo t@(IfaceLiteralTy _) = mkReflCo <$> tcIfaceType t
tcIfaceCo t@(IfaceLitTy _) = mkReflCo <$> tcIfaceType t
tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
tcIfaceCo (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' ->
mkForAllCo tv' <$> tcIfaceCo t
......
......@@ -602,7 +602,7 @@ flatten d ctxt ty
= do { (xi, co) <- flatten d ctxt ty'
; return (xi,co) }
flatten _ _ xi@(LiteralTy _) = return (xi, mkTcReflCo xi)
flatten _ _ xi@(LitTy {}) = return (xi, mkTcReflCo xi)
flatten d ctxt (TyVarTy tv)
= do { ieqs <- getInertEqs
......@@ -745,7 +745,7 @@ flatten d ctxt ty@(ForAllTy {})
where under_families tvs rho
= go (mkVarSet tvs) rho
where go _bound (TyVarTy _tv) = False
go _ (LiteralTy _) = False
go _ (LitTy {}) = False
go bound (TyConApp tc tys)
| isSynFamilyTyCon tc
, (args,rest) <- splitAt (tyConArity tc) tys
......@@ -1430,7 +1430,7 @@ expandAway tv ty@(ForAllTy {})
expandAway tv ty@(TyConApp tc tys)
= (mkTyConApp tc <$> mapM (expandAway tv) tys) <|> (tcView ty >>= expandAway tv)
expandAway _ xi@(LiteralTy _) = return xi
expandAway _ xi@(LitTy {}) = return xi
\end{code}
......
......@@ -686,7 +686,7 @@ quickFlattenTy :: TcType -> TcM TcType
quickFlattenTy ty | Just ty' <- tcView ty = quickFlattenTy ty'
quickFlattenTy ty@(TyVarTy {}) = return ty
quickFlattenTy ty@(ForAllTy {}) = return ty -- See
quickFlattenTy ty@(LiteralTy _) = return ty
quickFlattenTy ty@(LitTy {}) = return ty
-- Don't flatten because of the danger or removing a bound variable
quickFlattenTy (AppTy ty1 ty2) = do { fy1 <- quickFlattenTy ty1
; fy2 <- quickFlattenTy ty2
......
......@@ -262,7 +262,7 @@ liftTcCoSubstWith tvs cos ty
Nothing -> mkTcReflCo ty
go (AppTy t1 t2) = mkTcAppCo (go t1) (go t2)
go (TyConApp tc tys) = mkTcTyConAppCo tc (map go tys)
go ty@(LiteralTy _) = mkTcReflCo ty
go ty@(LitTy {}) = mkTcReflCo ty
go (ForAllTy tv ty) = mkTcForAllCo tv (go ty)
go (FunTy t1 t2) = mkTcFunCo (go t1) (go t2)
\end{code}
......
......@@ -166,11 +166,8 @@ normaliseFfiType' env ty0 = go [] ty0
= do (coi,nty1) <- go rec_nts ty1
return (mkForAllCo tyvar coi, ForAllTy tyvar nty1)
go _ ty@(TyVarTy _)
= return (Refl ty, ty)
go _ ty@(LiteralTy _)
= return (Refl ty, ty)
go _ ty@(TyVarTy {}) = return (Refl ty, ty)
go _ ty@(LitTy {}) = return (Refl ty, ty)
add_co co rec_nts ty
= do (co', ty') <- go rec_nts ty
......
......@@ -812,7 +812,7 @@ zonkType zonk_tc_tyvar ty
go (TyConApp tc tys) = do tys' <- mapM go tys
return (TyConApp tc tys')
go (LiteralTy n) = return (LiteralTy n)
go (LitTy n) = return (LitTy n)
go (FunTy arg res) = do arg' <- go arg
res' <- go res
......@@ -1082,7 +1082,7 @@ check_type rank ubx_tup ty@(TyConApp tc tys)
arity_msg = arityErr "Type synonym" (tyConName tc) tc_arity n_args
ubx_tup_msg = ubxArgTyErr ty
check_type _ _ (LiteralTy _) = return ()
check_type _ _ (LitTy {}) = return ()
check_type _ _ ty = pprPanic "check_type" (ppr ty)
......@@ -1749,7 +1749,7 @@ fvType :: Type -> [TyVar]
fvType ty | Just exp_ty <- tcView ty = fvType exp_ty
fvType (TyVarTy tv) = [tv]
fvType (TyConApp _ tys) = fvTypes tys
fvType (LiteralTy _) = []
fvType (LitTy {}) = []
fvType (FunTy arg res) = fvType arg ++ fvType res
fvType (AppTy fun arg) = fvType fun ++ fvType arg
fvType (ForAllTy tyvar ty) = filter (/= tyvar) (fvType ty)
......@@ -1760,9 +1760,9 @@ fvTypes tys = concat (map fvType tys)
sizeType :: Type -> Int
-- Size of a type: the number of variables and constructors
sizeType ty | Just exp_ty <- tcView ty = sizeType exp_ty
sizeType (TyVarTy _) = 1
sizeType (TyVarTy {}) = 1
sizeType (TyConApp _ tys) = sizeTypes tys + 1
sizeType (LiteralTy _) = 1
sizeType (LitTy {}) = 1
sizeType (FunTy arg res) = sizeType arg + sizeType res + 1
sizeType (AppTy fun arg) = sizeType fun + sizeType arg
sizeType (ForAllTy _ ty) = sizeType ty
......
......@@ -896,7 +896,7 @@ floatEqualities skols can_given wantders
| FlatSkol ty <- tcTyVarDetails tv = tvs_under_fsks ty
| otherwise = unitVarSet tv
tvs_under_fsks (TyConApp _ tys) = unionVarSets (map tvs_under_fsks tys)
tvs_under_fsks (LiteralTy _) = emptyVarSet
tvs_under_fsks (LitTy {}) = emptyVarSet
tvs_under_fsks (FunTy arg res) = tvs_under_fsks arg `unionVarSet` tvs_under_fsks res
tvs_under_fsks (AppTy fun arg) = tvs_under_fsks fun `unionVarSet` tvs_under_fsks arg
tvs_under_fsks (ForAllTy tv ty) -- The kind of a coercion binder
......
......@@ -1302,13 +1302,13 @@ reifyFamilyInstance fi
reifyType :: TypeRep.Type -> TcM TH.Type
-- Monadic only because of failure
reifyType ty@(ForAllTy _ _) = reify_for_all ty
reifyType (LitTy {}) = failWith $ ptext $ sLit "Type-level literal canont be reifyed yet."
reifyType (TyVarTy tv) = return (TH.VarT (reifyName tv))
reifyType (TyConApp tc tys) = reify_tc_app tc tys -- Do not expand type synonyms here
reifyType (AppTy t1 t2) = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) }
reifyType ty@(FunTy t1 t2)
| isPredTy t1 = reify_for_all ty -- Types like ((?x::Int) => Char -> Char)
| otherwise = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) }
reifyType (LiteralTy _) = failWith $ ptext $ sLit "Type-level literal canont be reifyed yet."
reify_for_all :: TypeRep.Type -> TcM TH.Type
reify_for_all ty
......
......@@ -237,8 +237,8 @@ calcClassCycles cls
| otherwise
= flip (foldr (expandType seen path)) tys
expandType _ _ (TyVarTy _) = id
expandType _ _ (LiteralTy _) = id
expandType _ _ (TyVarTy {}) = id
expandType _ _ (LitTy {}) = id
expandType seen path (AppTy t1 t2) = expandType seen path t1 . expandType seen path t2
expandType seen path (FunTy t1 t2) = expandType seen path t1 . expandType seen path t2
expandType seen path (ForAllTy _tv t) = expandType seen path t
......@@ -473,8 +473,8 @@ tcTyConsOfType ty
where
go :: Type -> NameEnv TyCon -- The NameEnv does duplicate elim
go ty | Just ty' <- tcView ty = go ty'
go (TyVarTy _) = emptyNameEnv
go (LiteralTy _) = emptyNameEnv
go (TyVarTy {}) = emptyNameEnv
go (LitTy {}) = emptyNameEnv
go (TyConApp tc tys) = go_tc tc tys
go (AppTy a b) = go a `plusNameEnv` go b
go (FunTy a b) = go a `plusNameEnv` go b
......
......@@ -501,7 +501,7 @@ tidyType env@(_, subst) ty
Just tv' -> expand tv'
go (TyConApp tycon tys) = let args = map go tys
in args `seqList` TyConApp tycon args
go (LiteralTy n) = LiteralTy n
go (LitTy n) = LitTy n
go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
......@@ -591,14 +591,14 @@ tidyCos env = map (tidyCo env)
tcTyFamInsts :: Type -> [(TyCon, [Type])]
tcTyFamInsts ty
| Just exp_ty <- tcView ty = tcTyFamInsts exp_ty
tcTyFamInsts (TyVarTy _) = []
tcTyFamInsts (TyVarTy _) = []
tcTyFamInsts (TyConApp tc tys)
| isSynFamilyTyCon tc = [(tc, tys)]
| isSynFamilyTyCon tc = [(tc, tys)]
| otherwise = concat (map tcTyFamInsts tys)
tcTyFamInsts (LiteralTy _) = []
tcTyFamInsts (FunTy ty1 ty2) = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
tcTyFamInsts (AppTy ty1 ty2) = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
tcTyFamInsts (ForAllTy _ ty) = tcTyFamInsts ty
tcTyFamInsts (LitTy {}) = []
tcTyFamInsts (FunTy ty1 ty2) = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
tcTyFamInsts (AppTy ty1 ty2) = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
tcTyFamInsts (ForAllTy _ ty) = tcTyFamInsts ty
\end{code}
%************************************************************************
......@@ -645,7 +645,7 @@ exactTyVarsOfType ty
go ty | Just ty' <- tcView ty = go ty' -- This is the key line
go (TyVarTy tv) = unitVarSet tv
go (TyConApp _ tys) = exactTyVarsOfTypes tys
go (LiteralTy _) = emptyVarSet
go (LitTy {}) = emptyVarSet
go (FunTy arg res) = go arg `unionVarSet` go res
go (AppTy fun arg) = go fun `unionVarSet` go arg
go (ForAllTy tyvar ty) = delVarSet (go ty) tyvar
......@@ -781,7 +781,7 @@ getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
getDFunTyKey (TyVarTy tv) = getOccName tv
getDFunTyKey (TyConApp tc _) = getOccName tc
getDFunTyKey (LiteralTy x) = getDFunTyLitKey x
getDFunTyKey (LitTy x) = getDFunTyLitKey x
getDFunTyKey (AppTy fun _) = getDFunTyKey fun
getDFunTyKey (FunTy _ _) = getOccName funTyCon
getDFunTyKey (ForAllTy _ t) = getDFunTyKey t
......@@ -1177,7 +1177,7 @@ tcTyVarsOfType :: Type -> TcTyVarSet
tcTyVarsOfType (TyVarTy tv) = if isTcTyVar tv then unitVarSet tv
else emptyVarSet
tcTyVarsOfType (TyConApp _ tys) = tcTyVarsOfTypes tys
tcTyVarsOfType (LiteralTy _) = emptyVarSet
tcTyVarsOfType (LitTy {}) = emptyVarSet
tcTyVarsOfType (FunTy arg res) = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
tcTyVarsOfType (AppTy fun arg) = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
tcTyVarsOfType (ForAllTy tyvar ty) = tcTyVarsOfType ty `delVarSet` tyvar
......@@ -1202,7 +1202,7 @@ orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
orphNamesOfType (TyVarTy _) = emptyNameSet
orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
`unionNameSets` orphNamesOfTypes tys
orphNamesOfType (LiteralTy _) = emptyNameSet
orphNamesOfType (LitTy {}) = emptyNameSet
orphNamesOfType (FunTy arg res) = orphNamesOfType arg `unionNameSets` orphNamesOfType res
orphNamesOfType (AppTy fun arg) = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
orphNamesOfType (ForAllTy _ ty) = orphNamesOfType ty
......
......@@ -616,7 +616,7 @@ uType_np origin orig_ty1 orig_ty2
= do { cos <- uList origin uType tys1 tys2
; return $ mkTcTyConAppCo tc1 cos }
go (LiteralTy m) ty@(LiteralTy n)
go (LitTy m) ty@(LitTy n)
| m == n
= return $ mkTcReflCo ty
......@@ -916,7 +916,7 @@ checkTauTvUpdate tv ty
= Just (TyConApp tc tys')
| isSynTyCon tc, Just ty_expanded <- tcView this_ty
= ok ty_expanded -- See Note [Type synonyms and the occur check]
ok ty@(LiteralTy _) = Just ty
ok ty@(LitTy {}) = Just ty
ok (FunTy arg res) | Just arg' <- ok arg, Just res' <- ok res
= Just (FunTy arg' res')
ok (AppTy fun arg) | Just fun' <- ok fun, Just arg' <- ok arg
......
......@@ -939,7 +939,7 @@ ty_co_subst subst ty
go (ForAllTy v ty) = mkForAllCo v' $! (ty_co_subst subst' ty)
where
(subst', v') = liftCoSubstTyVarBndr subst v
go ty@(LiteralTy _) = mkReflCo ty
go ty@(LitTy {}) = mkReflCo ty
liftCoSubstTyVar :: LiftCoSubst -> TyVar -> Maybe Coercion
liftCoSubstTyVar (LCS _ cenv) tv = lookupVarEnv cenv tv
......
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