diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-02-26 17:26:56 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-03-02 16:31:06 +0000 |
commit | 9b3239f81261f05ee3285c1b9dcbe113635145ef (patch) | |
tree | 7c7ba322e5d70cf57821273e13f0586fb85df231 | |
parent | 772737195823ac399203ac4cc4b051d8028eee1d (diff) | |
download | haskell-9b3239f81261f05ee3285c1b9dcbe113635145ef.tar.gz |
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
-rw-r--r-- | compiler/typecheck/TcDeriv.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcFlatten.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcTyDecls.hs | 2 | ||||
-rw-r--r-- | compiler/types/Coercion.hs | 2 | ||||
-rw-r--r-- | compiler/types/FamInstEnv.hs | 2 | ||||
-rw-r--r-- | compiler/types/TyCon.hs | 44 | ||||
-rw-r--r-- | compiler/types/Type.hs | 20 |
7 files changed, 24 insertions, 50 deletions
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 166d2f91b4..04023b56fb 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -1623,7 +1623,7 @@ mkNewTypeEqn dflags overlap_mode tvs -- We generate the instance -- 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 -- eta-reduces the representation type, so we know that -- T a ~ S a a diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index ba25b8bb95..9e8a392ba6 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -796,7 +796,7 @@ flatten_one fmode (TyConApp tc tys) -- Expand type synonyms that mention type families -- 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' = case fe_mode fmode of FM_FlattenAll | anyNameEnv isTypeFamilyTyCon (tyConsOfType rhs) diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs index f7cde08c7b..94442901a9 100644 --- a/compiler/typecheck/TcTyDecls.hs +++ b/compiler/typecheck/TcTyDecls.hs @@ -409,7 +409,7 @@ calcRecFlags boot_details is_boot mrole_env tyclss -- for vanilla-ness of data constructors; and that depends -- on empty existential type variables; and that is figured -- 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. -- YUK YUK YUK diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index c191f19ee4..95623628a1 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -981,7 +981,7 @@ mkAppCos co1 cos = foldl mkAppCo co1 cos mkTyConAppCo :: Role -> TyCon -> [Coercion] -> Coercion mkTyConAppCo r tc cos -- 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 | Just tys <- traverse isReflCo_maybe cos diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index a8ddda3ca0..b121c733df 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -913,7 +913,7 @@ normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type) -- See comments on normaliseType for the arguments of this function normaliseTcApp env role tc tys | 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) = if isReflCo co2 then (args_co, mkTyConApp tc ntys) else (args_co `mkTransCo` co2, mkAppTys ninst_rhs ntys') diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 2d8a27721f..514273cf64 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -76,7 +76,7 @@ module TyCon( tupleTyConBoxity, tupleTyConSort, tupleTyConArity, -- ** Manipulating TyCons - tcExpandTyCon_maybe, coreExpandTyCon_maybe, + expandSynTyCon_maybe, makeTyConAbstract, newTyConCo, newTyConCo_maybe, pprPromotionQuote, @@ -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 Parser, in this case to ([], Froogle), so that even unsaturated applications of Parser will work right. This eta reduction is done when the type -constructor is built, and cached in NewTyCon. The cached field is -only used in coreExpandTyCon_maybe. +constructor is built, and cached in NewTyCon. Here's an example that I think showed up in practice Source code: @@ -845,14 +844,7 @@ Source code: After desugaring, and discarding the data constructors for the newtypes, 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 - so the coercion tycon CoT must have kind: T ~ [] and arity: 0 @@ -1477,7 +1469,7 @@ tyConCType_maybe _ = Nothing ----------------------------------------------- -} -tcExpandTyCon_maybe, coreExpandTyCon_maybe +expandSynTyCon_maybe :: TyCon -> [tyco] -- ^ Arguments to 'TyCon' -> Maybe ([(TyVar,tyco)], @@ -1487,32 +1479,18 @@ tcExpandTyCon_maybe, coreExpandTyCon_maybe -- and any arguments remaining from the -- application --- ^ Used to create the view the /typechecker/ has on 'TyCon's. --- We expand (closed) synonyms only, cf. 'coreExpandTyCon_maybe' -tcExpandTyCon_maybe (SynonymTyCon { tyConTyVars = tvs - , synTcRhs = rhs }) tys - = 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 +-- ^ Expand a type synonym application, if any +expandSynTyCon_maybe tc tys + | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs } <- tc + , let n_tvs = length tvs = case n_tvs `compare` length tys of LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys) EQ -> Just (tvs `zip` tys, rhs, []) GT -> Nothing - where - n_tvs = length tvs + | otherwise + = Nothing + +---------------- -- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no -- constructors could be found diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index c1b3930346..a2d339210c 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -245,29 +245,25 @@ infixr 3 `mkFunTy` -- Associates to the right {-# INLINE coreView #-} coreView :: Type -> Maybe Type --- ^ In Core, we \"look through\" non-recursive newtypes and 'PredTypes': this --- function tries to obtain a different view of the supplied type given this --- --- Strips off the /top layer only/ of a type to give --- its underlying representation type. +-- ^ This function Strips off the /top layer only/ of a type synonym +-- application (if any) its underlying representation type. -- Returns Nothing if there is nothing to look through. -- -- By being non-recursive and inlined, this case analysis gets efficiently -- 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') -- Its important to use mkAppTys, rather than (foldl AppTy), -- because the function part might well return a -- partially-applied type constructor; indeed, usually will! -coreView _ = Nothing +coreView _ = Nothing ----------------------------------------------- {-# INLINE tcView #-} tcView :: Type -> Maybe Type --- ^ Similar to 'coreView', but for the type checker, which just looks through synonyms -tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys') -tcView _ = Nothing +-- ^ Historical only; 'tcView' and 'coreView' used to differ, but don't any more +tcView = coreView + -- ToDo: get rid of tcView altogether -- 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). -- So we will leave it here to avoid module loops. @@ -281,7 +277,7 @@ expandTypeSynonyms ty = go ty where 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') | otherwise = TyConApp tc (map go tys) |