summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2015-02-26 17:26:56 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2015-03-02 16:31:06 +0000
commit9b3239f81261f05ee3285c1b9dcbe113635145ef (patch)
tree7c7ba322e5d70cf57821273e13f0586fb85df231
parent772737195823ac399203ac4cc4b051d8028eee1d (diff)
downloadhaskell-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.hs2
-rw-r--r--compiler/typecheck/TcFlatten.hs2
-rw-r--r--compiler/typecheck/TcTyDecls.hs2
-rw-r--r--compiler/types/Coercion.hs2
-rw-r--r--compiler/types/FamInstEnv.hs2
-rw-r--r--compiler/types/TyCon.hs44
-rw-r--r--compiler/types/Type.hs20
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)