Commit 9b3239f8 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improve comments on coreView/tcView, and combine coreExpandTyCon/tcExpandTyCon

This is minor stuff triggered by Trac #10103.

* Fix outdated comments on tcView/coreView (we should really combine
  them with a new name, but I'll leave that slightly-disruptive change
  for now)

* Combine tcExpandTyCon_maybe and coreExpandTyCon_maybe (which were identical)
  into expandSynTyCon_maybe

* A few more comment fixups
parent 77273719
...@@ -1623,7 +1623,7 @@ mkNewTypeEqn dflags overlap_mode tvs ...@@ -1623,7 +1623,7 @@ mkNewTypeEqn dflags overlap_mode tvs
-- We generate the instance -- We generate the instance
-- instance Monad (ST s) => Monad (T s) where -- instance Monad (ST s) => Monad (T s) where
nt_eta_arity = length (fst (newTyConEtadRhs rep_tycon)) nt_eta_arity = newTyConEtadArity rep_tycon
-- For newtype T a b = MkT (S a a b), the TyCon machinery already -- For newtype T a b = MkT (S a a b), the TyCon machinery already
-- eta-reduces the representation type, so we know that -- eta-reduces the representation type, so we know that
-- T a ~ S a a -- T a ~ S a a
......
...@@ -796,7 +796,7 @@ flatten_one fmode (TyConApp tc tys) ...@@ -796,7 +796,7 @@ flatten_one fmode (TyConApp tc tys)
-- Expand type synonyms that mention type families -- Expand type synonyms that mention type families
-- on the RHS; see Note [Flattening synonyms] -- on the RHS; see Note [Flattening synonyms]
| Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
, let expanded_ty = mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys' , let expanded_ty = mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys'
= case fe_mode fmode of = case fe_mode fmode of
FM_FlattenAll | anyNameEnv isTypeFamilyTyCon (tyConsOfType rhs) FM_FlattenAll | anyNameEnv isTypeFamilyTyCon (tyConsOfType rhs)
......
...@@ -409,7 +409,7 @@ calcRecFlags boot_details is_boot mrole_env tyclss ...@@ -409,7 +409,7 @@ calcRecFlags boot_details is_boot mrole_env tyclss
-- for vanilla-ness of data constructors; and that depends -- for vanilla-ness of data constructors; and that depends
-- on empty existential type variables; and that is figured -- on empty existential type variables; and that is figured
-- out by tcResultType; which uses tcMatchTy; which uses -- out by tcResultType; which uses tcMatchTy; which uses
-- coreView; which calls coreExpandTyCon_maybe; which uses -- coreView; which calls expandSynTyCon_maybe; which uses
-- the recursiveness of the TyCon. Result... a black hole. -- the recursiveness of the TyCon. Result... a black hole.
-- YUK YUK YUK -- YUK YUK YUK
......
...@@ -981,7 +981,7 @@ mkAppCos co1 cos = foldl mkAppCo co1 cos ...@@ -981,7 +981,7 @@ mkAppCos co1 cos = foldl mkAppCo co1 cos
mkTyConAppCo :: Role -> TyCon -> [Coercion] -> Coercion mkTyConAppCo :: Role -> TyCon -> [Coercion] -> Coercion
mkTyConAppCo r tc cos mkTyConAppCo r tc cos
-- Expand type synonyms -- Expand type synonyms
| Just (tv_co_prs, rhs_ty, leftover_cos) <- tcExpandTyCon_maybe tc cos | Just (tv_co_prs, rhs_ty, leftover_cos) <- expandSynTyCon_maybe tc cos
= mkAppCos (liftCoSubst r tv_co_prs rhs_ty) leftover_cos = mkAppCos (liftCoSubst r tv_co_prs rhs_ty) leftover_cos
| Just tys <- traverse isReflCo_maybe cos | Just tys <- traverse isReflCo_maybe cos
......
...@@ -913,7 +913,7 @@ normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type) ...@@ -913,7 +913,7 @@ normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type)
-- See comments on normaliseType for the arguments of this function -- See comments on normaliseType for the arguments of this function
normaliseTcApp env role tc tys normaliseTcApp env role tc tys
| isTypeSynonymTyCon tc | isTypeSynonymTyCon tc
, Just (tenv, rhs, ntys') <- tcExpandTyCon_maybe tc ntys , Just (tenv, rhs, ntys') <- expandSynTyCon_maybe tc ntys
, (co2, ninst_rhs) <- normaliseType env role (Type.substTy (mkTopTvSubst tenv) rhs) , (co2, ninst_rhs) <- normaliseType env role (Type.substTy (mkTopTvSubst tenv) rhs)
= if isReflCo co2 then (args_co, mkTyConApp tc ntys) = if isReflCo co2 then (args_co, mkTyConApp tc ntys)
else (args_co `mkTransCo` co2, mkAppTys ninst_rhs ntys') else (args_co `mkTransCo` co2, mkAppTys ninst_rhs ntys')
......
...@@ -76,7 +76,7 @@ module TyCon( ...@@ -76,7 +76,7 @@ module TyCon(
tupleTyConBoxity, tupleTyConSort, tupleTyConArity, tupleTyConBoxity, tupleTyConSort, tupleTyConArity,
-- ** Manipulating TyCons -- ** Manipulating TyCons
tcExpandTyCon_maybe, coreExpandTyCon_maybe, expandSynTyCon_maybe,
makeTyConAbstract, makeTyConAbstract,
newTyConCo, newTyConCo_maybe, newTyConCo, newTyConCo_maybe,
pprPromotionQuote, pprPromotionQuote,
...@@ -829,8 +829,7 @@ which we need to make the derived instance for Monad Parser. ...@@ -829,8 +829,7 @@ which we need to make the derived instance for Monad Parser.
Well, yes. But to see that easily we eta-reduce the RHS type of Well, yes. But to see that easily we eta-reduce the RHS type of
Parser, in this case to ([], Froogle), so that even unsaturated applications Parser, in this case to ([], Froogle), so that even unsaturated applications
of Parser will work right. This eta reduction is done when the type of Parser will work right. This eta reduction is done when the type
constructor is built, and cached in NewTyCon. The cached field is constructor is built, and cached in NewTyCon.
only used in coreExpandTyCon_maybe.
Here's an example that I think showed up in practice Here's an example that I think showed up in practice
Source code: Source code:
...@@ -845,14 +844,7 @@ Source code: ...@@ -845,14 +844,7 @@ Source code:
After desugaring, and discarding the data constructors for the newtypes, After desugaring, and discarding the data constructors for the newtypes,
we get: we get:
w2 :: Foo T
w2 = w1
And now Lint complains unless Foo T == Foo [], and that requires T==[]
This point carries over to the newtype coercion, because we need to
say
w2 = w1 `cast` Foo CoT w2 = w1 `cast` Foo CoT
so the coercion tycon CoT must have so the coercion tycon CoT must have
kind: T ~ [] kind: T ~ []
and arity: 0 and arity: 0
...@@ -1477,7 +1469,7 @@ tyConCType_maybe _ = Nothing ...@@ -1477,7 +1469,7 @@ tyConCType_maybe _ = Nothing
----------------------------------------------- -----------------------------------------------
-} -}
tcExpandTyCon_maybe, coreExpandTyCon_maybe expandSynTyCon_maybe
:: TyCon :: TyCon
-> [tyco] -- ^ Arguments to 'TyCon' -> [tyco] -- ^ Arguments to 'TyCon'
-> Maybe ([(TyVar,tyco)], -> Maybe ([(TyVar,tyco)],
...@@ -1487,32 +1479,18 @@ tcExpandTyCon_maybe, coreExpandTyCon_maybe ...@@ -1487,32 +1479,18 @@ tcExpandTyCon_maybe, coreExpandTyCon_maybe
-- and any arguments remaining from the -- and any arguments remaining from the
-- application -- application
-- ^ Used to create the view the /typechecker/ has on 'TyCon's. -- ^ Expand a type synonym application, if any
-- We expand (closed) synonyms only, cf. 'coreExpandTyCon_maybe' expandSynTyCon_maybe tc tys
tcExpandTyCon_maybe (SynonymTyCon { tyConTyVars = tvs | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs } <- tc
, synTcRhs = rhs }) tys , let n_tvs = length tvs
= expand tvs rhs tys
tcExpandTyCon_maybe _ _ = Nothing
---------------
-- ^ Used to create the view /Core/ has on 'TyCon's. We expand
-- not only closed synonyms like 'tcExpandTyCon_maybe',
-- but also non-recursive @newtype@s
coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
----------------
expand :: [TyVar] -> Type -- Template
-> [a] -- Args
-> Maybe ([(TyVar,a)], Type, [a]) -- Expansion
expand tvs rhs tys
= case n_tvs `compare` length tys of = case n_tvs `compare` length tys of
LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys) LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
EQ -> Just (tvs `zip` tys, rhs, []) EQ -> Just (tvs `zip` tys, rhs, [])
GT -> Nothing GT -> Nothing
where | otherwise
n_tvs = length tvs = Nothing
----------------
-- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no -- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no
-- constructors could be found -- constructors could be found
......
...@@ -245,16 +245,13 @@ infixr 3 `mkFunTy` -- Associates to the right ...@@ -245,16 +245,13 @@ infixr 3 `mkFunTy` -- Associates to the right
{-# INLINE coreView #-} {-# INLINE coreView #-}
coreView :: Type -> Maybe Type coreView :: Type -> Maybe Type
-- ^ In Core, we \"look through\" non-recursive newtypes and 'PredTypes': this -- ^ This function Strips off the /top layer only/ of a type synonym
-- function tries to obtain a different view of the supplied type given this -- application (if any) its underlying representation type.
--
-- Strips off the /top layer only/ of a type to give
-- its underlying representation type.
-- Returns Nothing if there is nothing to look through. -- Returns Nothing if there is nothing to look through.
-- --
-- By being non-recursive and inlined, this case analysis gets efficiently -- By being non-recursive and inlined, this case analysis gets efficiently
-- joined onto the case analysis that the caller is already doing -- joined onto the case analysis that the caller is already doing
coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
= Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys') = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
-- Its important to use mkAppTys, rather than (foldl AppTy), -- Its important to use mkAppTys, rather than (foldl AppTy),
-- because the function part might well return a -- because the function part might well return a
...@@ -264,10 +261,9 @@ coreView _ = Nothing ...@@ -264,10 +261,9 @@ coreView _ = Nothing
----------------------------------------------- -----------------------------------------------
{-# INLINE tcView #-} {-# INLINE tcView #-}
tcView :: Type -> Maybe Type tcView :: Type -> Maybe Type
-- ^ Similar to 'coreView', but for the type checker, which just looks through synonyms -- ^ Historical only; 'tcView' and 'coreView' used to differ, but don't any more
tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys tcView = coreView
= Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys') -- ToDo: get rid of tcView altogether
tcView _ = Nothing
-- You might think that tcView belows in TcType rather than Type, but unfortunately -- You might think that tcView belows in TcType rather than Type, but unfortunately
-- it is needed by Unify, which is turn imported by Coercion (for MatchEnv and matchList). -- it is needed by Unify, which is turn imported by Coercion (for MatchEnv and matchList).
-- So we will leave it here to avoid module loops. -- So we will leave it here to avoid module loops.
...@@ -281,7 +277,7 @@ expandTypeSynonyms ty ...@@ -281,7 +277,7 @@ expandTypeSynonyms ty
= go ty = go ty
where where
go (TyConApp tc tys) go (TyConApp tc tys)
| Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
= go (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys') = go (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
| otherwise | otherwise
= TyConApp tc (map go tys) = TyConApp tc (map go tys)
......
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