diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-01-13 17:31:50 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-01-13 17:31:50 +0000 |
| commit | 23075169a7d85073cadb211835854436e533f046 (patch) | |
| tree | d55f9b6265c8033fae37f8e0d6fccb7e066a31ba | |
| parent | 85926ae6c63a62e4f23423f220588875c8f1ab45 (diff) | |
| download | haskell-23075169a7d85073cadb211835854436e533f046.tar.gz | |
Mainly, rename LiteralTy to LitTy
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) |
