summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-01-13 17:31:50 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2012-01-13 17:31:50 +0000
commit23075169a7d85073cadb211835854436e533f046 (patch)
treed55f9b6265c8033fae37f8e0d6fccb7e066a31ba
parent85926ae6c63a62e4f23423f220588875c8f1ab45 (diff)
downloadhaskell-23075169a7d85073cadb211835854436e533f046.tar.gz
Mainly, rename LiteralTy to LitTy
-rw-r--r--compiler/codeGen/ClosureInfo.lhs2
-rw-r--r--compiler/codeGen/StgCmmClosure.hs2
-rw-r--r--compiler/coreSyn/CoreLint.lhs2
-rw-r--r--compiler/coreSyn/MkExternalCore.lhs11
-rw-r--r--compiler/coreSyn/TrieMap.lhs5
-rw-r--r--compiler/iface/BinIface.hs4
-rw-r--r--compiler/iface/IfaceSyn.lhs2
-rw-r--r--compiler/iface/IfaceType.lhs6
-rw-r--r--compiler/iface/TcIface.lhs4
-rw-r--r--compiler/typecheck/TcCanonical.lhs6
-rw-r--r--compiler/typecheck/TcErrors.lhs2
-rw-r--r--compiler/typecheck/TcEvidence.lhs2
-rw-r--r--compiler/typecheck/TcForeign.lhs7
-rw-r--r--compiler/typecheck/TcMType.lhs10
-rw-r--r--compiler/typecheck/TcSimplify.lhs2
-rw-r--r--compiler/typecheck/TcSplice.lhs2
-rw-r--r--compiler/typecheck/TcTyDecls.lhs8
-rw-r--r--compiler/typecheck/TcType.lhs22
-rw-r--r--compiler/typecheck/TcUnify.lhs4
-rw-r--r--compiler/types/Coercion.lhs2
-rw-r--r--compiler/types/FamInstEnv.lhs2
-rw-r--r--compiler/types/Type.lhs20
-rw-r--r--compiler/types/TypeRep.lhs6
-rw-r--r--compiler/vectorise/Vectorise/Convert.hs10
-rw-r--r--compiler/vectorise/Vectorise/Type/Classify.hs2
-rw-r--r--compiler/vectorise/Vectorise/Type/Type.hs2
26 files changed, 72 insertions, 75 deletions
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 2cd0cf6434..fd27684732 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -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
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index d40ff9e1e5..7789ae865b 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -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
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 984e08b8f9..3b8b559f38 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -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
diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
index cb12973a60..d4a03ed67f 100644
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ b/compiler/coreSyn/MkExternalCore.lhs
@@ -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
diff --git a/compiler/coreSyn/TrieMap.lhs b/compiler/coreSyn/TrieMap.lhs
index e6779b7850..11a30a54c9 100644
--- a/compiler/coreSyn/TrieMap.lhs
+++ b/compiler/coreSyn/TrieMap.lhs
@@ -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
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 5cb7cd1e4d..4d6f17129a 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -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)
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index f01c3b63b3..ef74b13489 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -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
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 1565df1bc7..94e29d732e 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -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
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index c04d7284c5..36ca30ee04 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -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
diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index 480c1b16d9..237f73d1e3 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -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}
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 5a24419ad2..476ad6e84b 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -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
diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs
index e2313443aa..a6a7ce3dc0 100644
--- a/compiler/typecheck/TcEvidence.lhs
+++ b/compiler/typecheck/TcEvidence.lhs
@@ -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}
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 2996ce954c..f1c1e9c438 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -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
diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 67f79c435a..395b47770f 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -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
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 511e47eb5c..e541b87fd0 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -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
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 6efbdf9ee9..757ef4442c 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -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
diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs
index 8ac4ab8230..8f3ec5b4b9 100644
--- a/compiler/typecheck/TcTyDecls.lhs
+++ b/compiler/typecheck/TcTyDecls.lhs
@@ -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
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 808d538443..aac60f578b 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -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
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index ffe9958c6d..71c372330f 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -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
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index 6ea45ffd37..4c1ab4aa5f 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -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
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index 891af71bc7..b1ab2f6101 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -668,7 +668,7 @@ normaliseType env ty
| Just ty' <- coreView ty = normaliseType env ty'
normaliseType env (TyConApp tc tys)
= normaliseTcApp env tc tys
-normaliseType _env ty@(LiteralTy _) = (Refl ty, ty)
+normaliseType _env ty@(LitTy {}) = (Refl ty, ty)
normaliseType env (AppTy ty1 ty2)
= let (coi1,nty1) = normaliseType env ty1
(coi2,nty2) = normaliseType env ty2
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index a4f4252d74..81075c0e7a 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -279,7 +279,7 @@ expandTypeSynonyms ty
= go (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
| otherwise
= TyConApp tc (map go tys)
- go (LiteralTy l) = LiteralTy l
+ go (LitTy l) = LitTy l
go (TyVarTy tv) = TyVarTy tv
go (AppTy t1 t2) = AppTy (go t1) (go t2)
go (FunTy t1 t2) = FunTy (go t1) (go t2)
@@ -406,12 +406,12 @@ splitAppTys ty = split ty ty []
\end{code}
- LiteralTy
+ LitTy
~~~~~~~~~
\begin{code}
mkLiteralTy :: TyLit -> Type
-mkLiteralTy = LiteralTy
+mkLiteralTy = LitTy
mkNumberTyLit :: Integer -> TyLit
mkNumberTyLit = NumberTyLit
@@ -420,8 +420,8 @@ mkNumberTy :: Integer -> Type
mkNumberTy n = mkLiteralTy (mkNumberTyLit n)
isNumberTy :: Type -> Maybe Integer
-isNumberTy (LiteralTy (NumberTyLit n)) = Just n
-isNumberTy _ = Nothing
+isNumberTy (LitTy (NumberTyLit n)) = Just n
+isNumberTy _ = Nothing
\end{code}
@@ -989,12 +989,12 @@ getIPPredTy_maybe ty = case splitTyConApp_maybe ty of
\begin{code}
typeSize :: Type -> Int
-typeSize (TyVarTy _) = 1
+typeSize (LitTy {}) = 1
+typeSize (TyVarTy {}) = 1
typeSize (AppTy t1 t2) = typeSize t1 + typeSize t2
typeSize (FunTy t1 t2) = typeSize t1 + typeSize t2
typeSize (ForAllTy _ t) = 1 + typeSize t
typeSize (TyConApp _ ts) = 1 + sum (map typeSize ts)
-typeSize (LiteralTy _) = 1
varSetElemsKvsFirst :: VarSet -> [TyVar]
-- {k1,a,k2,b} --> [k1,k2,a,b]
@@ -1147,12 +1147,12 @@ isPrimitiveType ty = case splitTyConApp_maybe ty of
\begin{code}
seqType :: Type -> ()
+seqType (LitTy n) = n `seq` ()
seqType (TyVarTy tv) = tv `seq` ()
seqType (AppTy t1 t2) = seqType t1 `seq` seqType t2
seqType (FunTy t1 t2) = seqType t1 `seq` seqType t2
seqType (TyConApp tc tys) = tc `seq` seqTypes tys
seqType (ForAllTy tv ty) = tv `seq` seqType ty
-seqType (LiteralTy n) = n `seq` ()
seqTypes :: [Type] -> ()
seqTypes [] = ()
@@ -1474,6 +1474,7 @@ subst_ty :: TvSubst -> Type -> Type
subst_ty subst ty
= go ty
where
+ go (LitTy n) = n `seq` LitTy n
go (TyVarTy tv) = substTyVar subst tv
go (TyConApp tc tys) = let args = map go tys
in args `seqList` TyConApp tc args
@@ -1486,7 +1487,6 @@ subst_ty subst ty
go (ForAllTy tv ty) = case substTyVarBndr subst tv of
(subst', tv') ->
ForAllTy tv' $! (subst_ty subst' ty)
- go (LiteralTy n) = n `seq` LiteralTy n
substTyVar :: TvSubst -> TyVar -> Type
substTyVar (TvSubst _ tenv) tv
@@ -1574,7 +1574,7 @@ typeKind (TyConApp tc tys)
= kindAppResult (tyConKind tc) tys
typeKind (AppTy fun arg) = kindAppResult (typeKind fun) [arg]
-typeKind (LiteralTy l) = typeLiteralKind l
+typeKind (LitTy l) = typeLiteralKind l
typeKind (ForAllTy _ ty) = typeKind ty
typeKind (TyVarTy tyvar) = tyVarKind tyvar
typeKind (FunTy _arg res)
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index c830a12ac3..1ab2f2e788 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -113,7 +113,7 @@ data Type
Var -- Type or kind variable
Type -- ^ A polymorphic type
- | LiteralTy TyLit -- ^ Type literals are simillar to type constructors.
+ | LitTy TyLit -- ^ Type literals are simillar to type constructors.
deriving (Data.Data, Data.Typeable)
@@ -289,7 +289,7 @@ tyVarsOfType :: Type -> VarSet
-- kind variable {k}
tyVarsOfType (TyVarTy v) = unitVarSet v
tyVarsOfType (TyConApp _ tys) = tyVarsOfTypes tys
-tyVarsOfType (LiteralTy _) = emptyVarSet
+tyVarsOfType (LitTy {}) = emptyVarSet
tyVarsOfType (FunTy arg res) = tyVarsOfType arg `unionVarSet` tyVarsOfType res
tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
tyVarsOfType (ForAllTy tyvar ty) = delVarSet (tyVarsOfType ty) tyvar
@@ -538,7 +538,7 @@ instance Outputable name => OutputableBndr (IPName name) where
ppr_type :: Prec -> Type -> SDoc
ppr_type _ (TyVarTy tv) = ppr_tvar tv
ppr_type p (TyConApp tc tys) = pprTcApp p ppr_type tc tys
-ppr_type p (LiteralTy l) = ppr_tylit p l
+ppr_type p (LitTy l) = ppr_tylit p l
ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
pprType t1 <+> ppr_type TyConPrec t2
diff --git a/compiler/vectorise/Vectorise/Convert.hs b/compiler/vectorise/Vectorise/Convert.hs
index 751fdace50..048362d59c 100644
--- a/compiler/vectorise/Vectorise/Convert.hs
+++ b/compiler/vectorise/Vectorise/Convert.hs
@@ -78,11 +78,11 @@ identityConv (TyConApp tycon tys)
= do { mapM_ identityConv tys
; identityConvTyCon tycon
}
-identityConv (LiteralTy _) = noV $ text "identityConv: not sure about literal types under vectorisation"
-identityConv (TyVarTy _) = noV $ text "identityConv: type variable changes under vectorisation"
-identityConv (AppTy _ _) = noV $ text "identityConv: type appl. changes under vectorisation"
-identityConv (FunTy _ _) = noV $ text "identityConv: function type changes under vectorisation"
-identityConv (ForAllTy _ _) = noV $ text "identityConv: quantified type changes under vectorisation"
+identityConv (LitTy {}) = noV $ text "identityConv: not sure about literal types under vectorisation"
+identityConv (TyVarTy {}) = noV $ text "identityConv: type variable changes under vectorisation"
+identityConv (AppTy {}) = noV $ text "identityConv: type appl. changes under vectorisation"
+identityConv (FunTy {}) = noV $ text "identityConv: function type changes under vectorisation"
+identityConv (ForAllTy {}) = noV $ text "identityConv: quantified type changes under vectorisation"
-- |Check that this type constructor is neutral under type vectorisation — i.e., it is not altered
-- by vectorisation as they contain no parallel arrays.
diff --git a/compiler/vectorise/Vectorise/Type/Classify.hs b/compiler/vectorise/Vectorise/Type/Classify.hs
index ff3803730e..559bbac1b6 100644
--- a/compiler/vectorise/Vectorise/Type/Classify.hs
+++ b/compiler/vectorise/Vectorise/Type/Classify.hs
@@ -106,5 +106,5 @@ tyConsOfType (TyConApp tc tys) = extend (tyConsOfTypes tys)
tyConsOfType (AppTy a b) = tyConsOfType a `unionUniqSets` tyConsOfType b
tyConsOfType (FunTy a b) = (tyConsOfType a `unionUniqSets` tyConsOfType b)
`addOneToUniqSet` funTyCon
-tyConsOfType (LiteralTy _) = emptyUniqSet
+tyConsOfType (LitTy _) = emptyUniqSet
tyConsOfType (ForAllTy _ ty) = tyConsOfType ty
diff --git a/compiler/vectorise/Vectorise/Type/Type.hs b/compiler/vectorise/Vectorise/Type/Type.hs
index 336b12618d..a7ec86a296 100644
--- a/compiler/vectorise/Vectorise/Type/Type.hs
+++ b/compiler/vectorise/Vectorise/Type/Type.hs
@@ -59,7 +59,7 @@ vectType ty
| Just ty' <- coreView ty
= vectType ty'
vectType (TyVarTy tv) = return $ TyVarTy tv
-vectType (LiteralTy l) = return $ LiteralTy l
+vectType (LitTy l) = return $ LitTy l
vectType (AppTy ty1 ty2) = AppTy <$> vectType ty1 <*> vectType ty2
vectType (TyConApp tc tys) = TyConApp <$> vectTyCon tc <*> mapM vectType tys
vectType (FunTy ty1 ty2)