summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2014-12-01 10:52:09 +0100
committerHerbert Valerio Riedel <hvr@gnu.org>2014-12-01 10:54:51 +0100
commite992317be141bb93363a13543d810da1ecfeccdd (patch)
tree0b1aa6bfd4b4cd23afdf206b334e5b84577d97a1
parent4b16ff6d5d89ba7054daad312acf32de4140488e (diff)
downloadhaskell-e992317be141bb93363a13543d810da1ecfeccdd.tar.gz
unlit compiler/types/ modules
Differential Revision: https://phabricator.haskell.org/D544
Diffstat
-rw-r--r--compiler/types/Class.hs (renamed from compiler/types/Class.lhs)55
-rw-r--r--compiler/types/CoAxiom.hs (renamed from compiler/types/CoAxiom.lhs)80
-rw-r--r--compiler/types/Coercion.hs (renamed from compiler/types/Coercion.lhs)172
-rw-r--r--compiler/types/FamInstEnv.hs (renamed from compiler/types/FamInstEnv.lhs)141
-rw-r--r--compiler/types/InstEnv.hs (renamed from compiler/types/InstEnv.lhs)106
-rw-r--r--compiler/types/Kind.hs (renamed from compiler/types/Kind.lhs)18
-rw-r--r--compiler/types/OptCoercion.hs (renamed from compiler/types/OptCoercion.lhs)26
-rw-r--r--compiler/types/TyCon.hs (renamed from compiler/types/TyCon.lhs)99
-rw-r--r--compiler/types/TyCon.hs-boot (renamed from compiler/types/TyCon.lhs-boot)2
-rw-r--r--compiler/types/Type.hs (renamed from compiler/types/Type.lhs)225
-rw-r--r--compiler/types/Type.hs-boot (renamed from compiler/types/Type.lhs-boot)2
-rw-r--r--compiler/types/TypeRep.hs (renamed from compiler/types/TypeRep.lhs)112
-rw-r--r--compiler/types/TypeRep.hs-boot (renamed from compiler/types/TypeRep.lhs-boot)3
-rw-r--r--compiler/types/Unify.hs (renamed from compiler/types/Unify.lhs)100
14 files changed, 504 insertions, 637 deletions
diff --git a/compiler/types/Class.lhs b/compiler/types/Class.hs
index 5fa1c946cc..946ed3d345 100644
--- a/compiler/types/Class.lhs
+++ b/compiler/types/Class.hs
@@ -1,11 +1,8 @@
-%
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+-- (c) The University of Glasgow 2006
+-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+--
+-- The @Class@ datatype
-The @Class@ datatype
-
-\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
module Class (
@@ -38,17 +35,17 @@ import BooleanFormula (BooleanFormula)
import Data.Typeable (Typeable)
import qualified Data.Data as Data
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection[Class-basic]{@Class@: basic definition}
-%* *
-%************************************************************************
+* *
+************************************************************************
A @Class@ corresponds to a Greek kappa in the static semantics:
+-}
-\begin{code}
data Class
= Class {
classTyCon :: TyCon, -- The data type constructor for
@@ -108,8 +105,8 @@ defMethSpecOfDefMeth meth
NoDefMeth -> NoDM
DefMeth _ -> VanillaDM
GenDefMeth _ -> GenericDM
-\end{code}
+{-
Note [Associated type defaults]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The following is an example of associated type defaults:
@@ -142,8 +139,8 @@ Note that
the default Type rhs
The @mkClass@ function fills in the indirect superclasses.
+-}
-\begin{code}
mkClass :: [TyVar]
-> [([TyVar], [TyVar])]
-> [PredType] -> [Id]
@@ -165,8 +162,8 @@ mkClass tyvars fds super_classes superdict_sels at_stuff
classOpStuff = op_stuff,
classMinimalDef = mindef,
classTyCon = tycon }
-\end{code}
+{-
Note [Associated type tyvar names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The TyCon of an associated type should use the same variable names as its
@@ -186,15 +183,15 @@ Having the same variables for class and tycon is also used in checkValidRoles
(in TcTyClsDecls) when checking a class's roles.
-%************************************************************************
-%* *
+************************************************************************
+* *
\subsection[Class-selectors]{@Class@: simple selectors}
-%* *
-%************************************************************************
+* *
+************************************************************************
The rest of these functions are just simple selectors.
+-}
-\begin{code}
classArity :: Class -> Arity
classArity clas = length (classTyVars clas)
-- Could memoise this
@@ -240,18 +237,17 @@ classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
classSCTheta = sc_theta, classSCSels = sc_sels,
classATStuff = ats, classOpStuff = op_stuff})
= (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection[Class-instances]{Instance declarations for @Class@}
-%* *
-%************************************************************************
+* *
+************************************************************************
We compare @Classes@ by their keys (which include @Uniques@).
+-}
-\begin{code}
instance Eq Class where
c1 == c2 = classKey c1 == classKey c2
c1 /= c2 = classKey c1 /= classKey c2
@@ -262,9 +258,7 @@ instance Ord Class where
c1 >= c2 = classKey c1 >= classKey c2
c1 > c2 = classKey c1 > classKey c2
compare c1 c2 = classKey c1 `compare` classKey c2
-\end{code}
-\begin{code}
instance Uniquable Class where
getUnique c = classKey c
@@ -291,4 +285,3 @@ instance Data.Data Class where
toConstr _ = abstractConstr "Class"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Class"
-\end{code}
diff --git a/compiler/types/CoAxiom.lhs b/compiler/types/CoAxiom.hs
index 06b74a43f0..a3e2bb220a 100644
--- a/compiler/types/CoAxiom.lhs
+++ b/compiler/types/CoAxiom.hs
@@ -1,8 +1,4 @@
-%
-% (c) The University of Glasgow 2012
-%
-
-\begin{code}
+-- (c) The University of Glasgow 2012
{-# LANGUAGE CPP, DeriveDataTypeable, GADTs, ScopedTypeVariables #-}
@@ -16,7 +12,7 @@ module CoAxiom (
brListLength, brListNth, brListMap, brListFoldr, brListMapM,
brListFoldlM_, brListZipWith,
- CoAxiom(..), CoAxBranch(..),
+ CoAxiom(..), CoAxBranch(..),
toBranchedAxiom, toUnbranchedAxiom,
coAxiomName, coAxiomArity, coAxiomBranches,
@@ -30,7 +26,7 @@ module CoAxiom (
CoAxiomRule(..), Eqn,
BuiltInSynFamily(..), trivialBuiltInFamily
- ) where
+ ) where
import {-# SOURCE #-} TypeRep ( Type )
import {-# SOURCE #-} TyCon ( TyCon )
@@ -49,8 +45,7 @@ import qualified Data.Data as Data
#include "HsVersions.h"
-\end{code}
-
+{-
Note [Coercion axiom branches]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In order to allow type family instance groups, an axiom needs to contain an
@@ -120,13 +115,13 @@ longer needs to remain compatible with GHC 7.2.x, then please update this
code to use promoted types.
-%************************************************************************
-%* *
+************************************************************************
+* *
Branch lists
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
type BranchIndex = Int -- The index of the branch in the list of branches
-- Counting from zero
@@ -205,13 +200,13 @@ brListZipWith f (NextBranch a ta) (NextBranch b tb) = f a b : brListZipWith f ta
instance Outputable a => Outputable (BranchList a br) where
ppr = ppr . fromBranchList
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Coercion axioms
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Storing compatibility]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -231,8 +226,8 @@ axiom as a whole, and they are computed only when the final axiom is built.
During serialization, the list is converted into a list of the indices
of the branches.
+-}
-\begin{code}
-- | A 'CoAxiom' is a \"coercion constructor\", i.e. a named equality axiom.
-- If you edit this type, you may need to update the GHC formalism
@@ -331,15 +326,14 @@ coAxBranchIncomps = cab_incomps
placeHolderIncomps :: [CoAxBranch]
placeHolderIncomps = panic "placeHolderIncomps"
-\end{code}
-
+{-
Note [CoAxBranch type variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In the case of a CoAxBranch of an associated type-family instance,
+In the case of a CoAxBranch of an associated type-family instance,
we use the *same* type variables (where possible) as the
enclosing class or instance. Consider
class C a b where
- type F x b
+ type F x b
type F [y] b = ... -- Second param must be b
instance C Int [z] where
@@ -347,7 +341,7 @@ enclosing class or instance. Consider
In the CoAxBranch in the instance decl (F Int [z]) we use the
same 'z', so that it's easy to check that that type is the same
-as that in the instance header.
+as that in the instance header.
Similarly in the CoAxBranch for the default decl for F in the
class decl, we use the same 'b' to make the same check easy.
@@ -381,11 +375,11 @@ the newtype tycon; family axioms are all at role N.
Note [CoAxiom locations]
~~~~~~~~~~~~~~~~~~~~~~~~
The source location of a CoAxiom is stored in two places in the
-datatype tree.
+datatype tree.
* The first is in the location info buried in the Name of the
CoAxiom. This span includes all of the branches of a branched
CoAxiom.
- * The second is in the cab_loc fields of the CoAxBranches.
+ * The second is in the cab_loc fields of the CoAxBranches.
In the case of a single branch, we can extract the source location of
the branch from the name of the CoAxiom. In other cases, we need an
@@ -402,8 +396,8 @@ See also Note [Implicit TyThings] in HscTypes
That is, it does not have its own IfaceAxiom declaration in an
interface file; instead the CoAxiom is generated by type-checking
the newtype declaration
+-}
-\begin{code}
instance Eq (CoAxiom br) where
a == b = case (a `compare` b) of { EQ -> True; _ -> False }
a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
@@ -429,17 +423,16 @@ instance Typeable br => Data.Data (CoAxiom br) where
toConstr _ = abstractConstr "CoAxiom"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "CoAxiom"
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Roles
-%* *
-%************************************************************************
+* *
+************************************************************************
Roles are defined here to avoid circular dependencies.
-
-\begin{code}
+-}
-- See Note [Roles] in Coercion
-- defined here to avoid cyclic dependency with Coercion
@@ -469,15 +462,13 @@ instance Binary Role where
3 -> return Phantom
_ -> panic ("get Role " ++ show tag)
-\end{code}
-
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
CoAxiomRule
Rules for building Evidence
-%* *
-%************************************************************************
+* *
+************************************************************************
Conditional axioms. The general idea is that a `CoAxiomRule` looks like this:
@@ -487,8 +478,8 @@ My intention is to reuse these for both (~) and (~#).
The short-term plan is to use this datatype to represent the type-nat axioms.
In the longer run, it may be good to unify this and `CoAxiom`,
as `CoAxiom` is the special case when there are no assumptions.
+-}
-\begin{code}
-- | A more explicit representation for `t1 ~ t2`.
type Eqn = Pair Type
@@ -539,6 +530,3 @@ trivialBuiltInFamily = BuiltInSynFamily
, sfInteractTop = \_ _ -> []
, sfInteractInert = \_ _ _ _ -> []
}
-
-\end{code}
-
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.hs
index dc0a7d0d45..a16a146eab 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.hs
@@ -1,8 +1,5 @@
-%
-% (c) The University of Glasgow 2006
-%
+-- (c) The University of Glasgow 2006
-\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
-- | Module for (a) type kinds and (b) type coercions,
@@ -110,15 +107,15 @@ import ListSetOps
import qualified Data.Data as Data hiding ( TyCon )
import Control.Arrow ( first )
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | A 'Coercion' is concrete evidence of the equality/convertibility
-- of two types.
@@ -215,8 +212,8 @@ instance Binary LeftOrRight where
pickLR :: LeftOrRight -> (a,a) -> a
pickLR CLeft (l,_) = l
pickLR CRight (_,r) = r
-\end{code}
+{-
Note [Refl invariant]
~~~~~~~~~~~~~~~~~~~~~
Coercions have the following invariant
@@ -490,13 +487,13 @@ necessary for soundness, but this choice removes ambiguity.
The rules here also dictate what the parameters to mkTyConAppCo.
-%************************************************************************
-%* *
+************************************************************************
+* *
\subsection{Coercion variables}
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
coVarName :: CoVar -> Name
coVarName = varName
@@ -515,10 +512,7 @@ isCoVarType ty -- Tests for t1 ~# t2, the unboxed equality
Just (tc,tys) -> (tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey)
&& tys `lengthAtLeast` 2
Nothing -> False
-\end{code}
-
-\begin{code}
tyCoVarsOfCo :: Coercion -> VarSet
-- Extracts type and coercion variables from a coercion
tyCoVarsOfCo (Refl _ ty) = tyVarsOfType ty
@@ -575,15 +569,15 @@ coercionSize (InstCo co ty) = 1 + coercionSize co + typeSize ty
coercionSize (SubCo co) = 1 + coercionSize co
coercionSize (AxiomRuleCo _ tys cos) = 1 + sum (map typeSize tys)
+ sum (map coercionSize cos)
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Tidying coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
tidyCo :: TidyEnv -> Coercion -> Coercion
tidyCo env@(_, subst) co
= go co
@@ -616,21 +610,21 @@ tidyCo env@(_, subst) co
tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
tidyCos env = map (tidyCo env)
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Pretty-printing coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
@pprCo@ is the standard @Coercion@ printer; the overloaded @ppr@
function is defined to use this. @pprParendCo@ is the same, except it
puts parens around the type, except for the atomic cases.
@pprParendCo@ works just by setting the initial context precedence
very high.
+-}
-\begin{code}
instance Outputable Coercion where
ppr = pprCo
@@ -718,9 +712,7 @@ ppr_forall_co p ty
(tvs, rho) = split1 [] ty
split1 tvs (ForAllCo tv ty) = split1 (tv:tvs) ty
split1 tvs ty = (reverse tvs, ty)
-\end{code}
-\begin{code}
pprCoAxiom :: CoAxiom br -> SDoc
pprCoAxiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches })
= hang (ptext (sLit "axiom") <+> ppr ax <+> dcolon)
@@ -746,15 +738,15 @@ pprCoAxBranchHdr ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_name = name }) index
| otherwise
= ptext (sLit "in") <+>
quotes (ppr (nameModule name))
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Functions over Kinds
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | This breaks a 'Coercion' with type @T A B C ~ T D E F@ into
-- a list of 'Coercion's of kinds @A ~ D@, @B ~ E@ and @E ~ F@. Hence:
--
@@ -827,13 +819,13 @@ isReflCo _ = False
isReflCo_maybe :: Coercion -> Maybe Type
isReflCo_maybe (Refl _ ty) = Just ty
isReflCo_maybe _ = Nothing
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Building coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Role twiddling functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -883,8 +875,8 @@ So, that's why this function is exported from this module.
One might ask: shouldn't downgradeRole_maybe just use setNominalRole_maybe as appropriate?
I (Richard E.) have decided not to do this, because upgrading a role is bizarre and
a caller should have to ask for this behavior explicitly.
+-}
-\begin{code}
mkCoVarCo :: CoVar -> Coercion
-- cv :: s ~# t
mkCoVarCo cv
@@ -1215,15 +1207,15 @@ mkCoCast c g
[_reflk, g1, g2] = decomposeCo 3 g
-- Remember, (~#) :: forall k. k -> k -> *
-- so it takes *three* arguments, not two
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Newtypes
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | If @co :: T ts ~ rep_ty@ then:
--
-- > instNewTyCon_maybe T ts = Just (rep_ty, co)
@@ -1276,16 +1268,15 @@ topNormaliseNewType_maybe ty
| otherwise -- No progress
= Nothing
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Equality of coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | Determines syntactic equality of coercions
coreEqCoercion :: Coercion -> Coercion -> Bool
coreEqCoercion co1 co2 = coreEqCoercion2 rn_env co1 co2
@@ -1334,15 +1325,15 @@ coreEqCoercion2 env (AxiomRuleCo a1 ts1 cs1) (AxiomRuleCo a2 ts2 cs2)
= a1 == a2 && all2 (eqTypeX env) ts1 ts2 && all2 (coreEqCoercion2 env) cs1 cs2
coreEqCoercion2 _ _ _ = False
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Substitution of coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | A substitution of 'Coercion's for 'CoVar's (OR 'TyVar's, when
-- doing a \"lifting\" substitution)
type CvSubstEnv = VarEnv Coercion
@@ -1501,14 +1492,14 @@ lookupTyVar (CvSubst _ tenv _) tv = lookupVarEnv tenv tv
lookupCoVar :: CvSubst -> Var -> Maybe Coercion
lookupCoVar (CvSubst _ _ cenv) v = lookupVarEnv cenv v
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
"Lifting" substitution
[(TyVar,Coercion)] -> Type -> Coercion
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Lifting coercions over types: liftCoSubst]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1551,8 +1542,8 @@ Happily we can do this because we know that all kind coercions
subst_kind: LiftCoSubst -> Kind -> Kind
that expects a Refl coercion (or something equivalent to Refl)
when it looks up a kind variable.
+-}
-\begin{code}
-- ----------------------------------------------------
-- See Note [Lifting coercions over types: liftCoSubst]
-- ----------------------------------------------------
@@ -1604,8 +1595,7 @@ ty_co_subst subst role ty
lift_phantom ty = mkUnivCo Phantom (liftCoSubstLeft subst ty)
(liftCoSubstRight subst ty)
-\end{code}
-
+{-
Note [liftCoSubstTyVar]
~~~~~~~~~~~~~~~~~~~~~~~
This function can fail (i.e., return Nothing) for two separate reasons:
@@ -1622,8 +1612,8 @@ you find that liftCoSubst is doing weird things (like leaving out-of-scope
variables lying around), disable coercion optimization (bypassing matchAxiom)
and use downgradeRole instead of downgradeRole_maybe. The panic will then happen,
and you may learn something useful.
+-}
-\begin{code}
liftCoSubstTyVar :: LiftCoSubst -> Role -> TyVar -> Maybe Coercion
liftCoSubstTyVar (LCS _ cenv) r tv
= do { co <- lookupVarEnv cenv tv
@@ -1680,9 +1670,7 @@ subst_kind subst@(LCS _ cenv) kind
pFst co_kind
| otherwise
= TyVarTy kv
-\end{code}
-\begin{code}
-- | 'liftCoMatch' is sort of inverse to 'liftCoSubst'. In particular, if
-- @liftCoMatch vars ty co == Just s@, then @tyCoSubst s ty == co@.
-- That is, it matches a type against a coercion of the same
@@ -1759,15 +1747,15 @@ pushRefl (Refl r (TyConApp tc tys))
= Just (TyConAppCo r tc (zipWith mkReflCo (tyConRolesX r tc) tys))
pushRefl (Refl r (ForAllTy tv ty)) = Just (ForAllCo tv (Refl r ty))
pushRefl _ = Nothing
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Sequencing on coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
seqCo :: Coercion -> ()
seqCo (Refl eq ty) = eq `seq` seqType ty
seqCo (TyConAppCo eq tc cos) = eq `seq` tc `seq` seqCos cos
@@ -1787,14 +1775,13 @@ seqCo (AxiomRuleCo _ ts cs) = seqTypes ts `seq` seqCos cs
seqCos :: [Coercion] -> ()
seqCos [] = ()
seqCos (co:cos) = seqCo co `seq` seqCos cos
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
The kind of a type, and of a coercion
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Computing a coercion kind and role]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1808,8 +1795,8 @@ sub-tree again. This was part of the problem in Trac #9233.
Solution: compute both together; hence coercionKindRole. We keep a
separate coercionKind function because it's a bit more efficient if
the kind is all you want.
+-}
-\begin{code}
coercionType :: Coercion -> Type
coercionType co = case coercionKindRole co of
(Pair ty1 ty2, r) -> mkCoercionType r ty1 ty2
@@ -1906,8 +1893,7 @@ coercionRole = snd . coercionKindRole
-- and role of its argument. Luckily, laziness should generally avoid
-- the need for computing kinds in other cases.
-\end{code}
-
+{-
Note [Nested InstCos]
~~~~~~~~~~~~~~~~~~~~~
In Trac #5631 we found that 70% of the entire compilation time was
@@ -1922,18 +1908,18 @@ But this is a *quadratic* algorithm, and the blew up Trac #5631.
So it's very important to do the substitution simultaneously.
cf Type.applyTys (which in fact we call here)
+-}
-
-\begin{code}
applyCo :: Type -> Coercion -> Type
-- Gives the type of (e co) where e :: (a~b) => ty
applyCo ty co | Just ty' <- coreView ty = applyCo ty' co
applyCo (FunTy _ ty) _ = ty
applyCo _ _ = panic "applyCo"
-\end{code}
+{-
Note [Kind coercions]
~~~~~~~~~~~~~~~~~~~~~
Kind coercions are only of the form: Refl kind. They are only used to
instantiate kind polymorphic type constructors in TyConAppCo. Remember
that kind instantiation only happens with TyConApp, not AppTy.
+-}
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.hs
index 32a3d68b2a..2cfc0fc677 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.hs
@@ -1,10 +1,7 @@
-%
-% (c) The University of Glasgow 2006
-%
-
-FamInstEnv: Type checked family instance declarations
+-- (c) The University of Glasgow 2006
+--
+-- FamInstEnv: Type checked family instance declarations
-\begin{code}
{-# LANGUAGE CPP, GADTs #-}
module FamInstEnv (
@@ -57,13 +54,13 @@ import Pair
import SrcLoc
import NameSet
import FastString
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Type checked family instance heads
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [FamInsts and CoAxioms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -79,8 +76,8 @@ Note [FamInsts and CoAxioms]
- The LHS of the CoAxiom is always of form F ty1 .. tyn
where F is a type family
+-}
-\begin{code}
data FamInst -- See Note [FamInsts and CoAxioms]
= FamInst { fi_axiom :: CoAxiom Unbranched -- The new coercion axiom introduced
-- by this family instance
@@ -111,10 +108,7 @@ data FamInst -- See Note [FamInsts and CoAxioms]
data FamFlavor
= SynFamilyInst -- A synonym family
| DataFamilyInst TyCon -- A data family, with its representation TyCon
-\end{code}
-
-\begin{code}
-- Obtain the axiom of a family instance
famInstAxiom :: FamInst -> CoAxiom Unbranched
famInstAxiom = fi_axiom
@@ -148,15 +142,15 @@ dataFamInstRepTyCon fi
= case fi_flavor fi of
DataFamilyInst tycon -> tycon
SynFamilyInst -> pprPanic "dataFamInstRepTyCon" (ppr fi)
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Pretty printing
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
instance NamedThing FamInst where
getName = coAxiomName . fi_axiom
@@ -213,8 +207,8 @@ pprFamInstHdr fi@(FamInst {fi_flavor = flavor})
pprFamInsts :: [FamInst] -> SDoc
pprFamInsts finsts = vcat (map pprFamInst finsts)
-\end{code}
+{-
Note [Lazy axiom match]
~~~~~~~~~~~~~~~~~~~~~~~
It is Vitally Important that mkImportedFamInst is *lazy* in its axiom
@@ -229,8 +223,8 @@ readiness has been achieved when some other code pulls on the axiom in the
FamInst. Thus, we pattern match on the axiom lazily (in the where clause,
not in the parameter list) and we assert the consistency of names there
also.
+-}
-\begin{code}
-- Make a family instance representation from the information found in an
-- interface file. In particular, we get the rough match info from the iface
-- (instead of computing it here).
@@ -262,13 +256,13 @@ mkImportedFamInst fam mb_tcs axiom
, ax' == axiom
-> DataFamilyInst tc
_ -> SynFamilyInst
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
FamInstEnv
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [FamInstEnv]
~~~~~~~~~~~~~~~~~
@@ -307,8 +301,8 @@ Then we get a data type for each instance, and an axiom:
These two axioms for T, one with one pattern, one with two. The reason
for this eta-reduction is decribed in TcInstDcls
Note [Eta reduction for data family axioms]
+-}
-\begin{code}
type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
-- See Note [FamInstEnv]
@@ -395,13 +389,13 @@ identicalFamInst (FamInst { fi_axiom = ax1 }) (FamInst { fi_axiom = ax2 })
tvs2 = mkVarSet (coAxBranchTyVars br2)
lhs1 = coAxBranchLHS br1
lhs2 = coAxBranchLHS br2
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Compatibility
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Apartness]
~~~~~~~~~~~~~~~~
@@ -472,8 +466,7 @@ find a branch that matches the target, but then we make sure that the target
is apart from every previous *incompatible* branch. We don't check the
branches that are compatible with the matching branch, because they are either
irrelevant (clause 1 of compatible) or benign (clause 2 of compatible).
-
-\begin{code}
+-}
-- See Note [Compatibility]
compatibleBranches :: CoAxBranch -> CoAxBranch -> Bool
@@ -503,23 +496,22 @@ computeAxiomIncomps ax@(CoAxiom { co_ax_branches = branches })
mk_incomps :: CoAxBranch -> [CoAxBranch] -> [CoAxBranch]
mk_incomps br = filter (not . compatibleBranches br)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Constructing axioms
These functions are here because tidyType / tcUnifyTysFG
are not available in CoAxiom
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Tidy axioms when we build them]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We print out axioms and don't want to print stuff like
F k k a b = ...
Instead we must tidy those kind variables. See Trac #7524.
+-}
-\begin{code}
-- all axiom roles are Nominal, as this is only used with type families
mkCoAxBranch :: [TyVar] -- original, possibly stale, tyvars
-> [Type] -- LHS patterns
@@ -568,13 +560,13 @@ mkSingleCoAxiom ax_name tvs fam_tc lhs_tys rhs_ty
, co_ax_branches = FirstBranch (branch { cab_incomps = [] }) }
where
branch = mkCoAxBranch tvs lhs_tys rhs_ty (getSrcSpan ax_name)
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Looking up a family instance
-%* *
-%************************************************************************
+* *
+************************************************************************
@lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
Multiple matches are only possible in case of type families (not data
@@ -592,8 +584,7 @@ desugared to
coe :Co:R42T a :: T [a] ~ :R42T a
we return the matching instance '(FamInst{.., fi_tycon = :R42T}, Int)'.
-
-\begin{code}
+-}
-- when matching a type family application, we get a FamInst,
-- and the list of types the axiom should be applied to
@@ -648,8 +639,8 @@ lookupFamInstEnvConflicts envs fam_inst@(FamInst { fi_axiom = new_axiom })
noSubst = panic "lookupFamInstEnvConflicts noSubst"
new_branch = coAxiomSingleBranch new_axiom
-\end{code}
+{-
Note [Family instance overlap conflicts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- In the case of data family instances, any overlap is fundamentally a
@@ -663,8 +654,8 @@ Note [Family instance overlap conflicts]
These two overlap on (F Int Int) but then both RHSs are Int,
so all is well. We require that they are syntactically equal;
anything else would be difficult to test for at this stage.
+-}
-\begin{code}
------------------------------------------------------------
-- Might be a one-way match or a unifier
type MatchFun = FamInst -- The FamInst template
@@ -733,8 +724,7 @@ lookup_fam_inst_env match_fun (pkg_ie, home_ie) fam tys
= lookup_fam_inst_env' match_fun home_ie fam tys
++ lookup_fam_inst_env' match_fun pkg_ie fam tys
-\end{code}
-
+{-
Note [Over-saturated matches]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's ok to look up an over-saturated type constructor. E.g.
@@ -759,8 +749,7 @@ We handle data families and type families separately here:
instance, because the breakdown might be different for each
instance. Why? Because of eta reduction; see Note [Eta reduction
for data family axioms] in TcInstDcls.
-
-\begin{code}
+-}
-- checks if one LHS is dominated by a list of other branches
-- in other words, if an application would match the first LHS, it is guaranteed
@@ -778,18 +767,18 @@ isDominatedBy branch branches
lhs = coAxBranchLHS branch
match (CoAxBranch { cab_tvs = tvs, cab_lhs = tys })
= isJust $ tcMatchTys (mkVarSet tvs) tys lhs
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Choosing an axiom application
-%* *
-%************************************************************************
+* *
+************************************************************************
The lookupFamInstEnv function does a nice job for *open* type families,
but we also need to handle closed ones when normalising a type:
+-}
-\begin{code}
reduceTyFamApp_maybe :: FamInstEnvs
-> Role -- Desired role of result coercion
-> TyCon -> [Type]
@@ -878,16 +867,15 @@ findBranch (CoAxBranch { cab_tvs = tpl_tvs, cab_lhs = tpl_lhs, cab_incomps = inc
-- fail if no branches left
findBranch [] _ _ = Nothing
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Looking up a family instance
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
topNormaliseType :: FamInstEnvs -> Type -> Type
topNormaliseType env ty = case topNormaliseType_maybe env ty of
Just (_co, ty') -> ty'
@@ -1000,13 +988,13 @@ normaliseType env role (ForAllTy tyvar ty1)
in (mkForAllCo tyvar coi, ForAllTy tyvar nty1)
normaliseType _ role ty@(TyVarTy _)
= (Refl role ty,ty)
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Flattening
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Flattening]
~~~~~~~~~~~~~~~~~
@@ -1019,8 +1007,7 @@ taking care to preserve sharing. That is, the type (Either (F a b) (F a b)) shou
flatten to (Either c c), never (Either c d).
Defined here because of module dependencies.
-
-\begin{code}
+-}
type FlattenMap = TypeMap TyVar
@@ -1101,5 +1088,3 @@ allTyVarsInTy = go
unitVarSet tv `unionVarSet`
(go ty) -- don't remove tv
go (LitTy {}) = emptyVarSet
-
-\end{code}
diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.hs
index cf7110981e..19fec2b179 100644
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.hs
@@ -1,12 +1,12 @@
-%
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
\section[InstEnv]{Utilities for typechecking instance declarations}
The bits common to TcInstDcls and TcDeriv.
+-}
-\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
module InstEnv (
@@ -51,16 +51,14 @@ import Data.Maybe ( isJust, isNothing )
#if __GLASGOW_HASKELL__ < 709
import Data.Monoid
#endif
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{The key types}
-%* *
-%************************************************************************
-
-\begin{code}
+* *
+************************************************************************
+-}
-- | Is this instance an orphan? If it is not an orphan, contains an 'OccName'
-- witnessing the instance's non-orphanhood.
@@ -90,7 +88,7 @@ instance Binary IsOrphan where
n <- get bh
return $ NotOrphan n
-data ClsInst
+data ClsInst
= ClsInst { -- Used for "rough matching"; see Note [Rough-match field]
-- INVARIANT: is_tcs = roughMatchTcs is_tys
is_cls_nm :: Name -- Class name
@@ -101,7 +99,7 @@ data ClsInst
-- See Note [Template tyvars are fresh]
, is_cls :: Class -- The real class
, is_tys :: [Type] -- Full arg types (mentioning is_tvs)
- -- INVARIANT: is_dfun Id has type
+ -- INVARIANT: is_dfun Id has type
-- forall is_tvs. (...) => is_cls is_tys
-- (modulo alpha conversion)
@@ -127,11 +125,11 @@ fuzzyClsInstCmp x y =
cmp (Nothing, Just _) = LT
cmp (Just _, Nothing) = GT
cmp (Just x, Just y) = stableNameCmp x y
-\end{code}
+{-
Note [Template tyvars are fresh]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The is_tvs field of a ClsInst has *completely fresh* tyvars.
+The is_tvs field of a ClsInst has *completely fresh* tyvars.
That is, they are
* distinct from any other ClsInst
* distinct from any tyvars free in predicates that may
@@ -150,7 +148,7 @@ which is a total waste of time if it has no chance of matching
So the Name, [Maybe Name] fields allow us to say "definitely
does not match", based only on the Name.
-In is_tcs,
+In is_tcs,
Nothing means that this type arg is a type variable
(Just n) means that this type arg is a
@@ -163,8 +161,8 @@ In is_tcs,
Note [Proper-match fields]
~~~~~~~~~~~~~~~~~~~~~~~~~
The is_tvs, is_cls, is_tys fields are simply cached values, pulled
-out (lazily) from the dfun id. They are cached here simply so
-that we don't need to decompose the DFunId each time we want
+out (lazily) from the dfun id. They are cached here simply so
+that we don't need to decompose the DFunId each time we want
to match it. The hope is that the fast-match fields mean
that we often never poke the proper-match fields.
@@ -188,8 +186,8 @@ being equal to
* the SrcSpan of
* the instance head type of
* the InstDecl used to construct the Instance.
+-}
-\begin{code}
instanceDFunId :: ClsInst -> DFunId
instanceDFunId = is_dfun
@@ -199,9 +197,7 @@ tidyClsInstDFun tidy_dfun ispec
instanceRoughTcs :: ClsInst -> [Maybe Name]
instanceRoughTcs = is_tcs
-\end{code}
-\begin{code}
instance NamedThing ClsInst where
getName ispec = getName (is_dfun ispec)
@@ -311,13 +307,12 @@ roughMatchTcs tys = map rough tys
instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
-- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
--- possibly be instantiated to actual, nor vice versa;
+-- possibly be instantiated to actual, nor vice versa;
-- False is non-committal
instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
instanceCantMatch _ _ = False -- Safe
-\end{code}
-
+{-
Note [Overlapping instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Overlap is permitted, but only in such a way that one can make
@@ -415,7 +410,7 @@ Old hugs had this same bug. Here's how we fixed it: like GHC, the
list of instances for a given class is ordered, so that more specific
instances come before more generic ones. For example, the instance
list for C might contain:
- ..., C Int, ..., C a, ...
+ ..., C Int, ..., C a, ...
When we go to look for a `C Int' instance we'll get that one first.
But what if we go looking for a `C b' (`b' is unconstrained)? We'll
pass the `C Int' instance, and keep going. But if `b' is
@@ -434,18 +429,18 @@ this test. Suppose the instance envt had
(still most specific first)
Now suppose we are looking for (C x y Int), where x and y are unconstrained.
C x y Int doesn't match the template {a,b} C a a b
-but neither does
+but neither does
C a a b match the template {x,y} C x y Int
But still x and y might subsequently be unified so they *do* match.
Simple story: unify, don't match.
-%************************************************************************
-%* *
+************************************************************************
+* *
InstEnv, ClsInstEnv
-%* *
-%************************************************************************
+* *
+************************************************************************
A @ClsInstEnv@ all the instances of that class. The @Id@ inside a
ClsInstEnv mapping is the dfun for that instance.
@@ -457,8 +452,8 @@ If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
or, to put it another way, we have
instance (...) => C t1 t2 t3, witnessed by dfun
+-}
-\begin{code}
---------------------------------------------------
type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
@@ -472,7 +467,7 @@ data InstEnvs = InstEnvs {
ie_visible :: VisibleOrphanModules
}
-newtype ClsInstEnv
+newtype ClsInstEnv
= ClsIE [ClsInst] -- The instances for a particular class, in any order
instance Outputable ClsInstEnv where
@@ -555,14 +550,13 @@ identicalInstHead (ClsInst { is_cls_nm = cls_nm1, is_tcs = rough1, is_tvs = tvs1
&& not (instanceCantMatch rough1 rough2) -- Fast check for no match, uses the "rough match" fields
&& isJust (tcMatchTys (mkVarSet tvs1) tys1 tys2)
&& isJust (tcMatchTys (mkVarSet tvs2) tys2 tys1)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Looking up an instance
-%* *
-%************************************************************************
+* *
+************************************************************************
@lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since
the env is kept ordered, the first match must be the only one. The
@@ -614,9 +608,8 @@ of the target constraint (C ty1 .. tyn). The search works like this.
* If only one candidate remains, pick it. Otherwise if all remaining
candidates are incoherent, pick an arbitrary candidate. Otherwise fail.
+-}
-
-\begin{code}
type DFunInstType = Maybe Type
-- Just ty => Instantiate with this type
-- Nothing => Instantiate with any type of this tyvar's kind
@@ -624,13 +617,13 @@ type DFunInstType = Maybe Type
type InstMatch = (ClsInst, [DFunInstType])
-type ClsInstLookupResult
+type ClsInstLookupResult
= ( [InstMatch] -- Successful matches
, [ClsInst] -- These don't match but do unify
, Bool) -- True if error condition caused by
-- SafeHaskell condition.
-\end{code}
+{-
Note [DFunInstType: instantiating types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A successful match is a ClsInst, together with the types at which
@@ -640,11 +633,11 @@ might have some tyvars that *only* appear in arguments
dfun :: forall a b. C a b, Ord b => D [a]
When we match this against D [ty], we return the instantiating types
[Just ty, Nothing]
-where the 'Nothing' indicates that 'b' can be freely instantiated.
-(The caller instantiates it to a flexi type variable, which will
+where the 'Nothing' indicates that 'b' can be freely instantiated.
+(The caller instantiates it to a flexi type variable, which will
presumably later become fixed via functional dependencies.)
+-}
-\begin{code}
-- |Look up an instance in the given instance environment. The given class application must match exactly
-- one instance and the match may not contain any flexi type variables. If the lookup is unsuccessful,
-- yield 'Left errorMessage'.
@@ -654,7 +647,7 @@ lookupUniqueInstEnv :: InstEnvs
-> Either MsgDoc (ClsInst, [Type])
lookupUniqueInstEnv instEnv cls tys
= case lookupInstEnv instEnv cls tys of
- ([(inst, inst_tys)], _, _)
+ ([(inst, inst_tys)], _, _)
| noFlexiVar -> Right (inst, inst_tys')
| otherwise -> Left $ ptext (sLit "flexible type variable:") <+>
(ppr $ mkTyConApp (classTyCon cls) tys)
@@ -835,8 +828,8 @@ insert_overlapping new_item (old_item : old_items)
-- marked as overlappable.
-- Latest change described in: Trac #9242.
-- Previous change: Trac #3877, Dec 10.
-\end{code}
+{-
Note [Incoherent instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
For some classes, the choice of a particular instance does not matter, any one
@@ -882,23 +875,23 @@ incoherent instances as long as there are are others.
-%************************************************************************
-%* *
+************************************************************************
+* *
Binding decisions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
instanceBindFun :: TyVar -> BindFlag
instanceBindFun tv | isTcTyVar tv && isOverlappableTyVar tv = Skolem
| otherwise = BindMe
-- Note [Binding when looking up instances]
-\end{code}
+{-
Note [Binding when looking up instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When looking up in the instance environment, or family-instance environment,
-we are careful about multiple matches, as described above in
+we are careful about multiple matches, as described above in
Note [Overlapping instances]
The key_tys can contain skolem constants, and we can guarantee that those
@@ -918,3 +911,4 @@ We do this only for isOverlappableTyVar skolems. For example we reject
g :: forall a => [a] -> Int
g x = op x
on the grounds that the correct instance depends on the instantiation of 'a'
+-}
diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.hs
index 04982825ac..a3e30a693a 100644
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.hs
@@ -1,8 +1,5 @@
-%
-% (c) The University of Glasgow 2006-2012
-%
+-- (c) The University of Glasgow 2006-2012
-\begin{code}
{-# LANGUAGE CPP #-}
module Kind (
-- * Main data type
@@ -57,13 +54,13 @@ import Outputable
import Maybes( orElse )
import Util
import FastString
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Functions over Kinds
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Kind Constraint and kind *]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -88,8 +85,8 @@ See Trac #7451.
Bottom line: although '*' and 'Constraint' are distinct TyCons, with
distinct uniques, they are treated as equal at all times except
during type inference. Hence cmpTc treats them as equal.
+-}
-\begin{code}
-- | Essentially 'funResultTy' on kinds handling pi-types too
kindFunResult :: SDoc -> Kind -> KindOrType -> Kind
kindFunResult _ (FunTy _ res) _ = res
@@ -302,4 +299,3 @@ kiVarsOfKind = tyVarsOfType
kiVarsOfKinds :: [Kind] -> VarSet
kiVarsOfKinds = tyVarsOfTypes
-\end{code}
diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.hs
index 1c88f46d6a..b75cd3019f 100644
--- a/compiler/types/OptCoercion.lhs
+++ b/compiler/types/OptCoercion.hs
@@ -1,8 +1,5 @@
-%
-% (c) The University of Glasgow 2006
-%
+-- (c) The University of Glasgow 2006
-\begin{code}
{-# LANGUAGE CPP #-}
module OptCoercion ( optCoercion, checkAxInstCo ) where
@@ -27,13 +24,13 @@ import Unify
import ListSetOps
import InstEnv
import Control.Monad ( zipWithM )
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Optimising coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Subtle shadowing in coercions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -67,8 +64,8 @@ checks that opt_co4 can avoid. This is a big win because Phantom coercions
rarely appear within non-phantom coercions -- only in some TyConAppCos
and some AxiomInstCos. We handle these cases specially by calling
opt_co2.
+-}
-\begin{code}
optCoercion :: CvSubst -> Coercion -> NormalCo
-- ^ optCoercion applies a substitution to a coercion,
-- *and* optimises it to reduce its size
@@ -517,8 +514,7 @@ fireTransRule _rule _co1 _co2 res
= -- pprTrace ("Trans rule fired: " ++ _rule) (vcat [ppr _co1, ppr _co2, ppr res]) $
Just res
-\end{code}
-
+{-
Note [Conflict checking with AxiomInstCo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the following type family and axiom:
@@ -573,8 +569,8 @@ that (Id Int) and (Id Bool) are Surely Apart, as they're headed by type
families. At the time of writing, I (Richard Eisenberg) couldn't think of
a way of detecting this any more efficient than just building the optimised
coercion and checking.
+-}
-\begin{code}
-- | Check to make sure that an AxInstCo is internally consistent.
-- Returns the conflicting branch, if it exists
-- See Note [Conflict checking with AxiomInstCo]
@@ -720,8 +716,8 @@ etaTyConAppCo_maybe tc co
| otherwise
= Nothing
-\end{code}
+{-
Note [Eta for AppCo]
~~~~~~~~~~~~~~~~~~~~
Suppose we have
@@ -742,4 +738,4 @@ because if g is well-kinded then
kind (s1 t2) = kind (s2 t2)
and these two imply
kind s1 = kind s2
-
+-}
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.hs
index 5281f9894b..c9dc88fe60 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.hs
@@ -1,11 +1,11 @@
-%
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
The @TyCon@ datatype
+-}
-\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
module TyCon(
@@ -111,8 +111,8 @@ import Constants
import Util
import qualified Data.Data as Data
import Data.Typeable (Typeable)
-\end{code}
+{-
-----------------------------------------------
Notes about type families
-----------------------------------------------
@@ -298,13 +298,13 @@ it's worth noting that (~#)'s parameters are at role N. Promoted data
constructors' type arguments are at role R. All kind arguments are at role
N.
-%************************************************************************
-%* *
+************************************************************************
+* *
\subsection{The data type}
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | TyCons represent type constructors. Type constructors are introduced by things such as:
--
-- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of kind @*@
@@ -620,13 +620,11 @@ data AlgTyConRhs
-- again check Trac #1072.
}
-\end{code}
-
+{-
Note [AbstractTyCon and type equality]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
TODO
-
-\begin{code}
+-}
-- | Extract those 'DataCon's that we are able to learn about. Note
-- that visibility in this sense does not correspond to visibility in
@@ -722,8 +720,8 @@ data FamTyConFlav
-- | Built-in type family used by the TypeNats solver
| BuiltInSynFamTyCon BuiltInSynFamily
-\end{code}
+{-
Note [Closed type families]
~~~~~~~~~~~~~~~~~~~~~~~~~
* In an open type family you can add new instances later. This is the
@@ -848,11 +846,11 @@ so the coercion tycon CoT must have
kind: T ~ []
and arity: 0
-%************************************************************************
-%* *
+************************************************************************
+* *
\subsection{PrimRep}
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [rep swamp]
@@ -909,8 +907,8 @@ This means to turn an ArgRep/PrimRep into a CmmType requires DynFlags.
On the other hand, CmmType includes some "nonsense" values, such as
CmmType GcPtrCat W32 on a 64-bit machine.
+-}
-\begin{code}
-- | A 'PrimRep' is an abstraction of a type. It contains information that
-- the code generator needs in order to pass arguments, return results,
-- and store values of this type.
@@ -978,21 +976,21 @@ primElemRepSizeB Word32ElemRep = 4
primElemRepSizeB Word64ElemRep = 8
primElemRepSizeB FloatElemRep = 4
primElemRepSizeB DoubleElemRep = 8
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{TyCon Construction}
-%* *
-%************************************************************************
+* *
+************************************************************************
Note: the TyCon constructors all take a Kind as one argument, even though
they could, in principle, work out their Kind from their other arguments.
But to do so they need functions from Types, and that makes a nasty
module mutual-recursion. And they aren't called from many places.
So we compromise, and move their Kind calculation to the call site.
+-}
-\begin{code}
-- | Given the name of the function type constructor and it's kind, create the
-- corresponding 'TyCon'. It is reccomended to use 'TypeRep.funTyCon' if you want
-- this functionality
@@ -1151,9 +1149,7 @@ mkPromotedTyCon tc kind
tyConKind = kind,
ty_con = tc
}
-\end{code}
-\begin{code}
isFunTyCon :: TyCon -> Bool
isFunTyCon (FunTyCon {}) = True
isFunTyCon _ = False
@@ -1458,14 +1454,13 @@ isImplicitTyCon (SynonymTyCon {}) = False
tyConCType_maybe :: TyCon -> Maybe CType
tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc
tyConCType_maybe _ = Nothing
-\end{code}
-
+{-
-----------------------------------------------
-- Expand type-constructor applications
-----------------------------------------------
+-}
-\begin{code}
tcExpandTyCon_maybe, coreExpandTyCon_maybe
:: TyCon
-> [tyco] -- ^ Arguments to 'TyCon'
@@ -1501,9 +1496,7 @@ expand tvs rhs tys
GT -> Nothing
where
n_tvs = length tvs
-\end{code}
-\begin{code}
-- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no constructors
-- could be found
tyConDataCons :: TyCon -> [DataCon]
@@ -1554,9 +1547,6 @@ tyConRoles tc
where
const_role r = replicate (tyConArity tc) r
-\end{code}
-
-\begin{code}
-- | Extract the bound type variables and type expansion of a type synonym 'TyCon'. Panics if the
-- 'TyCon' is not a synonym
newTyConRhs :: TyCon -> ([TyVar], Type)
@@ -1591,18 +1581,14 @@ newTyConCo tc = case newTyConCo_maybe tc of
tyConPrimRep :: TyCon -> PrimRep
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
-\end{code}
-\begin{code}
-- | Find the \"stupid theta\" of the 'TyCon'. A \"stupid theta\" is the context to the left of
-- an algebraic type declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@
tyConStupidTheta :: TyCon -> [PredType]
tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
tyConStupidTheta (TupleTyCon {}) = []
tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
-\end{code}
-\begin{code}
-- | Extract the 'TyVar's bound by a vanilla type synonym
-- and the corresponding (unsubstituted) right hand side.
synTyConDefn_maybe :: TyCon -> Maybe ([TyVar], Type)
@@ -1621,9 +1607,7 @@ synTyConRhs_maybe _ = Nothing
famTyConFlav_maybe :: TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe (FamilyTyCon {famTcFlav = flav}) = Just flav
famTyConFlav_maybe _ = Nothing
-\end{code}
-\begin{code}
-- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ type with one
-- alternative, a tuple type or a @newtype@ then that constructor is returned. If the 'TyCon'
-- has more than one constructor, or represents a primitive or function type constructor then
@@ -1640,9 +1624,7 @@ tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleAlgDataCon_maybe (TupleTyCon {dataCon = c}) = Just c
tyConSingleAlgDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = [c] }}) = Just c
tyConSingleAlgDataCon_maybe _ = Nothing
-\end{code}
-\begin{code}
-- | Is this 'TyCon' that for a class instance?
isClassTyCon :: TyCon -> Bool
isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
@@ -1693,21 +1675,20 @@ tyConFamilyCoercion_maybe tc
= case tyConParent tc of
FamInstTyCon co _ _ -> Just co
_ -> Nothing
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection[TyCon-instances]{Instance declarations for @TyCon@}
-%* *
-%************************************************************************
+* *
+************************************************************************
@TyCon@s are compared by comparing their @Unique@s.
The strictness analyser needs @Ord@. It is a lexicographic order with
the property @(a<=b) || (b<=a)@.
+-}
-\begin{code}
instance Eq TyCon where
a == b = case (a `compare` b) of { EQ -> True; _ -> False }
a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
@@ -1743,13 +1724,12 @@ instance Data.Data TyCon where
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "TyCon"
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Walking over recursive TyCons
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Expanding newtypes and products]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1779,8 +1759,8 @@ We sometimes want to do the same for product types, so that the
strictness analyser doesn't unbox infinitely deeply.
The function that manages this is checkRecTc.
+-}
-\begin{code}
newtype RecTcChecker = RC NameSet
initRecTc :: RecTcChecker
@@ -1795,4 +1775,3 @@ checkRecTc (RC rec_nts) tc
| otherwise = Just (RC (extendNameSet rec_nts tc_name))
where
tc_name = tyConName tc
-\end{code}
diff --git a/compiler/types/TyCon.lhs-boot b/compiler/types/TyCon.hs-boot
index d8ddff3f40..5d27fa0bc9 100644
--- a/compiler/types/TyCon.lhs-boot
+++ b/compiler/types/TyCon.hs-boot
@@ -1,4 +1,3 @@
-\begin{code}
module TyCon where
import Name (Name)
@@ -11,4 +10,3 @@ tyConUnique :: TyCon -> Unique
isTupleTyCon :: TyCon -> Bool
isUnboxedTupleTyCon :: TyCon -> Bool
isFunTyCon :: TyCon -> Bool
-\end{code}
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.hs
index ca77adc95b..45422194e6 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.hs
@@ -1,11 +1,8 @@
-%
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-Type - public interface
+-- (c) The University of Glasgow 2006
+-- (c) The GRASP/AQUA Project, Glasgow University, 1998
+--
+-- Type - public interface
-\begin{code}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -180,9 +177,7 @@ import Data.Maybe ( isJust )
import Control.Monad ( guard )
infixr 3 `mkFunTy` -- Associates to the right
-\end{code}
-\begin{code}
-- $type_classification
-- #type_classification#
--
@@ -237,15 +232,15 @@ infixr 3 `mkFunTy` -- Associates to the right
-- this module will automatically convert a source into a representation type
-- if they are spotted, to the best of it's abilities. If you don't want this
-- to happen, use the equivalent functions from the "TcType" module.
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Type representation
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
{-# INLINE coreView #-}
coreView :: Type -> Maybe Type
-- ^ In Core, we \"look through\" non-recursive newtypes and 'PredTypes': this
@@ -293,20 +288,20 @@ expandTypeSynonyms ty
go (AppTy t1 t2) = mkAppTy (go t1) (go t2)
go (FunTy t1 t2) = FunTy (go t1) (go t2)
go (ForAllTy tv t) = ForAllTy tv (go t)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{Constructor-specific functions}
-%* *
-%************************************************************************
+* *
+************************************************************************
---------------------------------------------------------------------
TyVarTy
~~~~~~~
-\begin{code}
+-}
+
-- | Attempts to obtain the type variable underlying a 'Type', and panics with the
-- given message if this is not a type variable type. See also 'getTyVar_maybe'
getTyVar :: String -> Type -> TyVar
@@ -332,17 +327,16 @@ allDistinctTyVars tkvs = go emptyVarSet tkvs
Nothing -> False
Just tv | tv `elemVarSet` so_far -> False
| otherwise -> go (so_far `extendVarSet` tv) tys
-\end{code}
-
+{-
---------------------------------------------------------------------
AppTy
~~~~~
We need to be pretty careful with AppTy to make sure we obey the
invariant that a TyConApp is always visibly so. mkAppTy maintains the
invariant: use it.
+-}
-\begin{code}
-- | Applies a type to another, as in e.g. @k a@
mkAppTy :: Type -> Type -> Type
mkAppTy (TyConApp tc tys) ty2 = mkTyConApp tc (tys ++ [ty2])
@@ -409,13 +403,11 @@ splitAppTys ty = split ty ty []
(TyConApp funTyCon [], [ty1,ty2])
split orig_ty _ args = (orig_ty, args)
-\end{code}
-
-
+{-
LitTy
~~~~~
+-}
-\begin{code}
mkNumLitTy :: Integer -> Type
mkNumLitTy n = LitTy (NumTyLit n)
@@ -434,14 +426,12 @@ isStrLitTy ty | Just ty1 <- tcView ty = isStrLitTy ty1
isStrLitTy (LitTy (StrTyLit s)) = Just s
isStrLitTy _ = Nothing
-\end{code}
-
-
+{-
---------------------------------------------------------------------
FunTy
~~~~~
+-}
-\begin{code}
mkFunTy :: Type -> Type -> Type
-- ^ Creates a function type from the given argument and result type
mkFunTy arg res = FunTy arg res
@@ -505,13 +495,13 @@ funArgTy :: Type -> Type
funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
funArgTy (FunTy arg _res) = arg
funArgTy ty = pprPanic "funArgTy" (ppr ty)
-\end{code}
+{-
---------------------------------------------------------------------
TyConApp
~~~~~~~~
+-}
-\begin{code}
-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to
-- its arguments. Applies its arguments to the constructor from left to right.
mkTyConApp :: TyCon -> [Type] -> Type
@@ -579,9 +569,8 @@ newTyConInstRhs tycon tys
applyTysX tvs rhs tys
where
(tvs, rhs) = newTyConEtadRhs tycon
-\end{code}
-
+{-
---------------------------------------------------------------------
SynTy
~~~~~
@@ -614,8 +603,8 @@ less than the Arity (as it would otherwise be for a function type like
As a result, ReprArity is always strictly positive if Arity is. This
is important because it allows us to distinguish at runtime between a
thunk and a function takes a nullary unboxed tuple as an argument!
+-}
-\begin{code}
type UnaryType = Type
data RepType = UbxTupleRep [UnaryType] -- INVARIANT: never an empty list (see Note [Nullary unboxed tuple])
@@ -704,8 +693,8 @@ isVoidTy :: Type -> Bool
isVoidTy ty = case repType ty of
UnaryRep (TyConApp tc _) -> isVoidRep (tyConPrimRep tc)
_ -> False
-\end{code}
+{-
Note [AppTy rep]
~~~~~~~~~~~~~~~~
Types of the form 'f a' must be of kind *, not #, so we are guaranteed
@@ -716,8 +705,8 @@ in TypeRep.
---------------------------------------------------------------------
ForAllTy
~~~~~~~~
+-}
-\begin{code}
mkForAllTy :: TyVar -> Type -> Type
mkForAllTy tyvar ty
= ForAllTy tyvar ty
@@ -772,14 +761,14 @@ splitForAllTys ty = split ty ty []
-- | Equivalent to @snd . splitForAllTys@
dropForAlls :: Type -> Type
dropForAlls ty = snd (splitForAllTys ty)
-\end{code}
+{-
-- (mkPiType now in CoreUtils)
applyTy, applyTys
~~~~~~~~~~~~~~~~~
+-}
-\begin{code}
-- | Instantiate a forall type with one or more type arguments.
-- Used when we have a polymorphic function applied to type args:
--
@@ -839,22 +828,21 @@ applyTysX tvs body_ty arg_tys
(drop n_tvs arg_tys)
where
n_tvs = length tvs
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Pred
-%* *
-%************************************************************************
+* *
+************************************************************************
Predicates on PredType
+-}
-\begin{code}
isPredTy :: Type -> Bool
-- NB: isPredTy is used when printing types, which can happen in debug printing
-- during type checking of not-fully-zonked types. So it's not cool to say
- -- isConstraintKind (typeKind ty) because absent zonking the type might
+ -- isConstraintKind (typeKind ty) because absent zonking the type might
-- be ill-kinded, and typeKind crashes
-- Hence the rather tiresome story here
isPredTy ty = go ty []
@@ -897,12 +885,13 @@ isIPPred_maybe ty =
guard (isIPTyCon tc)
x <- isStrLitTy t1
return (x,t2)
-\end{code}
+{-
Make PredTypes
--------------------- Equality types ---------------------------------
-\begin{code}
+-}
+
-- | Creates a type equality predicate
mkEqPred :: Type -> Type -> PredType
mkEqPred ty1 ty2
@@ -931,10 +920,9 @@ mkReprPrimEqPred ty1 ty2
TyConApp eqReprPrimTyCon [k, ty1, ty2]
where
k = typeKind ty1
-\end{code}
---------------------- Dictionary types ---------------------------------
-\begin{code}
+-- --------------------- Dictionary types ---------------------------------
+
mkClassPred :: Class -> [Type] -> PredType
mkClassPred clas tys = TyConApp (classTyCon clas) tys
@@ -948,8 +936,8 @@ isDictLikeTy ty = case splitTyConApp_maybe ty of
Just (tc, tys) | isClassTyCon tc -> True
| isTupleTyCon tc -> all isDictLikeTy tys
_other -> False
-\end{code}
+{-
Note [Dictionary-like types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Being "dictionary-like" means either a dictionary type or a tuple thereof.
@@ -981,8 +969,8 @@ constraints build tuples.
Decomposing PredType
+-}
-\begin{code}
data PredTree = ClassPred Class [Type]
| EqPred Type Type
| TuplePred [PredType]
@@ -998,9 +986,7 @@ classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
Just (tc, tys) | isTupleTyCon tc
-> TuplePred tys
_ -> IrredPred ev_ty
-\end{code}
-\begin{code}
getClassPredTys :: PredType -> (Class, [Type])
getClassPredTys ty = case getClassPredTys_maybe ty of
Just (clas, tys) -> (clas, tys)
@@ -1035,15 +1021,14 @@ getEqPredRole ty
| tc `hasKey` coercibleTyConKey -> Representational
_ -> pprPanic "getEqPredRole" (ppr ty)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Size
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
typeSize :: Type -> Int
typeSize (LitTy {}) = 1
typeSize (TyVarTy {}) = 1
@@ -1051,16 +1036,15 @@ 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)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{Type families}
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
mkFamilyTyConApp :: TyCon -> [Type] -> Type
-- ^ Given a family instance TyCon and its arg types, return the
-- corresponding family type. E.g:
@@ -1098,15 +1082,15 @@ pprSourceTyCon tycon
= ppr $ fam_tc `TyConApp` tys -- can't be FunTyCon
| otherwise
= ppr tycon
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{Liftedness}
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | See "Type#type_classification" for what an unlifted type is
isUnLiftedType :: Type -> Bool
-- isUnLiftedType returns True for forall'd unlifted types:
@@ -1145,34 +1129,29 @@ isClosedAlgType ty
Just (tc, ty_args) | isAlgTyCon tc && not (isFamilyTyCon tc)
-> ASSERT2( ty_args `lengthIs` tyConArity tc, ppr ty ) True
_other -> False
-\end{code}
-\begin{code}
-- | Computes whether an argument (or let right hand side) should
-- be computed strictly or lazily, based only on its type.
-- Currently, it's just 'isUnLiftedType'.
isStrictType :: Type -> Bool
isStrictType = isUnLiftedType
-\end{code}
-\begin{code}
isPrimitiveType :: Type -> Bool
-- ^ Returns true of types that are opaque to Haskell.
isPrimitiveType ty = case splitTyConApp_maybe ty of
Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
isPrimTyCon tc
_ -> False
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{Sequencing on types}
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
seqType :: Type -> ()
seqType (LitTy n) = n `seq` ()
seqType (TyVarTy tv) = tv `seq` ()
@@ -1184,17 +1163,16 @@ seqType (ForAllTy tv ty) = seqType (tyVarKind tv) `seq` seqType ty
seqTypes :: [Type] -> ()
seqTypes [] = ()
seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Comparison for types
(We don't use instances so that we know where it happens)
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
eqKind :: Kind -> Kind -> Bool
-- Watch out for horrible hack: See Note [Comparison with OpenTypeKind]
eqKind = eqType
@@ -1230,11 +1208,9 @@ eqTyVarBndrs env (tv1:tvs1) (tv2:tvs2)
| eqTypeX env (tyVarKind tv1) (tyVarKind tv2)
= eqTyVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2
eqTyVarBndrs _ _ _= Nothing
-\end{code}
-Now here comes the real worker
+-- Now here comes the real worker
-\begin{code}
cmpType :: Type -> Type -> Ordering
-- Watch out for horrible hack: See Note [Comparison with OpenTypeKind]
cmpType t1 t2 = cmpTypeX rn_env t1 t2
@@ -1305,7 +1281,7 @@ cmpTc :: TyCon -> TyCon -> Ordering
--
-- Also we treat OpenTypeKind as equal to either * or #
-- See Note [Comparison with OpenTypeKind]
-cmpTc tc1 tc2
+cmpTc tc1 tc2
| u1 == openTypeKindTyConKey, isSubOpenTypeKindKey u2 = EQ
| u2 == openTypeKindTyConKey, isSubOpenTypeKindKey u1 = EQ
| otherwise = nu1 `compare` nu2
@@ -1314,14 +1290,14 @@ cmpTc tc1 tc2
nu1 = if u1==constraintKindTyConKey then liftedTypeKindTyConKey else u1
u2 = tyConUnique tc2
nu2 = if u2==constraintKindTyConKey then liftedTypeKindTyConKey else u2
-\end{code}
+{-
Note [Comparison with OpenTypeKind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In PrimOpWrappers we have things like
PrimOpWrappers.mkWeak# = /\ a b c. Prim.mkWeak# a b c
where
- Prim.mkWeak# :: forall (a:Open) b c. a -> b -> c
+ Prim.mkWeak# :: forall (a:Open) b c. a -> b -> c
-> State# RealWorld -> (# State# RealWorld, Weak# b #)
Now, eta reduction will turn the definition into
PrimOpWrappers.mkWeak# = Prim.mkWeak#
@@ -1351,13 +1327,13 @@ kinds are compatible.
-- = cmpTypeX env (tyVarKind tv1) (tyVarKind tv2) `thenCmp`
-- cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
-%************************************************************************
-%* *
+************************************************************************
+* *
Type substitutions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
emptyTvSubstEnv :: TvSubstEnv
emptyTvSubstEnv = emptyVarEnv
@@ -1497,15 +1473,15 @@ instance Outputable TvSubst where
= brackets $ sep[ ptext (sLit "TvSubst"),
nest 2 (ptext (sLit "In scope:") <+> ppr ins),
nest 2 (ptext (sLit "Type env:") <+> ppr tenv) ]
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Performing type or kind substitutions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | Type substitution making use of an 'TvSubst' that
-- is assumed to be open, see 'zipOpenTvSubst'
substTyWith :: [TyVar] -> [Type] -> Type -> Type
@@ -1621,8 +1597,8 @@ cloneTyVarBndr (TvSubst in_scope tv_env) tv uniq
where
tv' = setVarUnique tv uniq -- Simply set the unique; the kind
-- has no type variables to worry about
-\end{code}
+{-
----------------------------------------------------
-- Kind Stuff
@@ -1631,26 +1607,26 @@ Kinds
For the description of subkinding in GHC, see
http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeType#Kinds
+-}
-\begin{code}
type MetaKindVar = TyVar -- invariant: MetaKindVar will always be a
-- TcTyVar with details MetaTv (TauTv ...) ...
-- meta kind var constructors and functions are in TcType
type SimpleKind = Kind
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
The kind of a type
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
typeKind :: Type -> Kind
typeKind orig_ty = go orig_ty
where
-
+
go ty@(TyConApp tc tys)
| isPromotedTyCon tc
= ASSERT( tyConArity tc == length tys ) superKind
@@ -1679,8 +1655,8 @@ typeLiteralKind l =
case l of
NumTyLit _ -> typeNatKind
StrTyLit _ -> typeSymbolKind
-\end{code}
+{-
Kind inference
~~~~~~~~~~~~~~
During kind inference, a kind variable unifies only with
@@ -1704,3 +1680,4 @@ When unifying two internal type variables, we collect their kind constraints by
finding the GLB of the two. Since the partial order is a tree, they only
have a glb if one is a sub-kind of the other. In that case, we bind the
less-informative one to the more informative one. Neat, eh?
+-}
diff --git a/compiler/types/Type.lhs-boot b/compiler/types/Type.hs-boot
index ff9db3e28c..587454e357 100644
--- a/compiler/types/Type.lhs-boot
+++ b/compiler/types/Type.hs-boot
@@ -1,4 +1,3 @@
-\begin{code}
module Type where
import {-# SOURCE #-} TypeRep( Type, Kind )
import Var
@@ -8,4 +7,3 @@ isPredTy :: Type -> Bool
typeKind :: Type -> Kind
substKiWith :: [KindVar] -> [Kind] -> Kind -> Kind
eqKind :: Kind -> Kind -> Bool
-\end{code}
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.hs
index c2f8a149b8..e4982b27a3 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.hs
@@ -1,7 +1,7 @@
- | %
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+
\section[TypeRep]{Type - friends' interface}
Note [The Type-related module hierarchy]
@@ -13,8 +13,8 @@ Note [The Type-related module hierarchy]
Kind imports TysPrim ( mainly for primitive kinds )
Type imports Kind
Coercion imports Type
+-}
-\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# OPTIONS_HADDOCK hide #-}
-- We expose the relevant stuff from this module via the Type module
@@ -82,17 +82,15 @@ import DynFlags
-- libraries
import Data.List( mapAccumL, partition )
import qualified Data.Data as Data hiding ( TyCon )
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{The data type}
-%* *
-%************************************************************************
-
+* *
+************************************************************************
+-}
-\begin{code}
-- | The key representation of types within the compiler
-- If you edit this type, you may need to update the GHC formalism
@@ -163,8 +161,8 @@ type Kind = Type
--
-- > TyConApp SuperKindTyCon ...
type SuperKind = Type
-\end{code}
+{-
Note [The kind invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~
The kinds
@@ -219,8 +217,8 @@ is encoded like this:
-------------------------------------
Note [PredTy]
+-}
-\begin{code}
-- | A type of the form @p@ of kind @Constraint@ represents a value whose type is
-- the Haskell predicate @p@, where a predicate is what occurs before
-- the @=>@ in a Haskell type.
@@ -245,8 +243,8 @@ type PredType = Type
-- | A collection of 'PredType's
type ThetaType = [PredType]
-\end{code}
+{-
(We don't support TREX records yet, but the setup is designed
to expand to allow them.)
@@ -259,16 +257,16 @@ The predicate really does turn into a real extra argument to the
function. If the argument has type (p :: Constraint) then the predicate p is
represented by evidence of type p.
-%************************************************************************
-%* *
+************************************************************************
+* *
Simple constructors
-%* *
-%************************************************************************
+* *
+************************************************************************
These functions are here so that they can be used by TysPrim,
which in turn is imported by Type
+-}
-\begin{code}
mkTyVarTy :: TyVar -> Type
mkTyVarTy = TyVarTy
@@ -278,11 +276,9 @@ mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
-- | Create the plain type constructor type which has been applied to no type arguments at all.
mkTyConTy :: TyCon -> Type
mkTyConTy tycon = TyConApp tycon []
-\end{code}
-Some basic functions, put here to break loops eg with the pretty printer
+-- Some basic functions, put here to break loops eg with the pretty printer
-\begin{code}
isLiftedTypeKind :: Kind -> Bool
isLiftedTypeKind (TyConApp tc []) = tc `hasKey` liftedTypeKindTyConKey
isLiftedTypeKind _ = False
@@ -297,16 +293,15 @@ isTypeVar v = isTKVar v && not (isSuperKind (varType v))
isKindVar :: Var -> Bool
isKindVar v = isTKVar v && isSuperKind (varType v)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Free variables of types and coercions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
tyVarsOfType :: Type -> VarSet
-- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
-- tyVarsOfType returns only the free variables of a type
@@ -336,13 +331,13 @@ varSetElemsKvsFirst set
= kvs ++ tvs
where
(kvs, tvs) = partition isKindVar (varSetElems set)
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
TyThing
-%* *
-%************************************************************************
+* *
+************************************************************************
Despite the fact that DataCon has to be imported via a hi-boot route,
this module seems the right place for TyThing, because it's needed for
@@ -355,8 +350,8 @@ as ATyCon. You can tell the difference, and get to the class, with
isClassTyCon :: TyCon -> Bool
tyConClass_maybe :: TyCon -> Maybe Class
The Class and its associated TyCon have the same Name.
+-}
-\begin{code}
-- | A typecheckable-thing, essentially anything that has a name
data TyThing
= AnId Id
@@ -387,17 +382,15 @@ instance NamedThing TyThing where -- Can't put this with the type
getName (ACoAxiom cc) = getName cc
getName (AConLike cl) = getName cl
-\end{code}
-
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Substitutions
Data type defined here to avoid unnecessary mutual recursion
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
-- | Type substitution
--
-- #tvsubst_invariant#
@@ -425,8 +418,8 @@ type TvSubstEnv = TyVarEnv Type
-- in the middle of matching, and unification (see Types.Unify)
-- So you have to look at the context to know if it's idempotent or
-- apply-once or whatever
-\end{code}
+{-
Note [Apply Once]
~~~~~~~~~~~~~~~~~
We use TvSubsts to instantiate things, and we might instantiate
@@ -472,13 +465,13 @@ This invariant has several crucial consequences:
-%************************************************************************
-%* *
+************************************************************************
+* *
Pretty-printing types
Defined very early because of debug printing in assertions
-%* *
-%************************************************************************
+* *
+************************************************************************
@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
defined to use this. @pprParendType@ is the same, except it puts
@@ -499,8 +492,8 @@ meaning (a :+: (T b)) -> c
Maybe operator applications should bind a bit less tightly?
Anyway, that's the current story, and it is used consistently for Type and HsType
+-}
-\begin{code}
data TyPrec -- See Note [Prededence in types]
= TopPrec -- No parens
@@ -667,8 +660,8 @@ pprTvBndr tv
| otherwise = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
where
kind = tyVarKind tv
-\end{code}
+{-
Note [When to print foralls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Mostly we want to print top-level foralls when (and only when) the user specifies
@@ -704,8 +697,8 @@ remember to parenthesise the operator, thus
(~>) a b -> b
See Trac #2766.
+-}
-\begin{code}
pprTypeApp :: TyCon -> [Type] -> SDoc
pprTypeApp tc tys = pprTyTcApp TopPrec tc tys
-- We have to use ppr on the TyCon (not its name)
@@ -827,17 +820,17 @@ pprArrowChain :: TyPrec -> [SDoc] -> SDoc
pprArrowChain _ [] = empty
pprArrowChain p (arg:args) = maybeParen p FunPrec $
sep [arg, sep (map (arrow <+>) args)]
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
\subsection{TidyType}
-%* *
-%************************************************************************
+* *
+************************************************************************
Tidying is here because it has a special case for FlatSkol
+-}
-\begin{code}
-- | This tidies up a type for printing in an error message, or in
-- an interface file.
--
@@ -936,4 +929,3 @@ tidyOpenKind = tidyOpenType
tidyKind :: TidyEnv -> Kind -> Kind
tidyKind = tidyType
-\end{code}
diff --git a/compiler/types/TypeRep.lhs-boot b/compiler/types/TypeRep.hs-boot
index aef7067ca7..94832b1a24 100644
--- a/compiler/types/TypeRep.lhs-boot
+++ b/compiler/types/TypeRep.hs-boot
@@ -1,4 +1,3 @@
-\begin{code}
module TypeRep where
import Outputable (Outputable)
@@ -11,5 +10,3 @@ type Kind = Type
type SuperKind = Type
instance Outputable Type
-\end{code}
-
diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.hs
index fe81d06e05..82fdad5eef 100644
--- a/compiler/types/Unify.lhs
+++ b/compiler/types/Unify.hs
@@ -1,8 +1,5 @@
-%
-% (c) The University of Glasgow 2006
-%
+-- (c) The University of Glasgow 2006
-\begin{code}
{-# LANGUAGE CPP #-}
module Unify (
@@ -38,14 +35,13 @@ import Control.Monad (liftM, ap)
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative (Applicative(..))
#endif
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Matching
-%* *
-%************************************************************************
+* *
+************************************************************************
Matching is much tricker than you might think.
@@ -68,9 +64,8 @@ Matching is much tricker than you might think.
where x is the template type variable. Then we do not want to
bind x to a/b! This is a kind of occurs check.
The necessary locals accumulate in the RnEnv2.
+-}
-
-\begin{code}
data MatchEnv
= ME { me_tmpls :: VarSet -- Template variables
, me_env :: RnEnv2 -- Renaming envt for nested foralls
@@ -141,11 +136,9 @@ ruleMatchTyX :: MatchEnv
-> Maybe TvSubstEnv
ruleMatchTyX menv subst ty1 ty2 = match menv subst ty1 ty2 -- Rename for export
-\end{code}
-Now the internals of matching
+-- Now the internals of matching
-\begin{code}
match :: MatchEnv -- For the most part this is pushed downwards
-> TvSubstEnv -- Substitution so far:
-- Domain is subset of template tyvars
@@ -239,14 +232,13 @@ matchList _ subst [] [] = Just subst
matchList fn subst (a:as) (b:bs) = do { subst' <- fn subst a b
; matchList fn subst' as bs }
matchList _ _ _ _ = Nothing
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
GADTs
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Pruning dead case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -312,8 +304,8 @@ drop more and more dead code.
For now we implement a very simple test: type variables match
anything, type functions (incl newtypes) match anything, and only
distinct data types fail to match. We can elaborate later.
+-}
-\begin{code}
typesCantMatch :: [(Type,Type)] -> Bool
typesCantMatch prs = any (\(s,t) -> cant_match s t) prs
where
@@ -348,14 +340,13 @@ typesCantMatch prs = any (\(s,t) -> cant_match s t) prs
-- foralls
-- look through newtypes
-- take account of tyvar bindings (EQ example above)
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Unification
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Fine-grained unification]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -433,8 +424,8 @@ it will look like these do *not* overlap, causing disaster. See Trac #9371.
In usages of tcUnifyTys outside of family instances, we always use tcUnifyTys,
which can't tell the difference between MaybeApart and SurelyApart, so those
usages won't notice this design choice.
+-}
-\begin{code}
tcUnifyTy :: Type -> Type -- All tyvars are bindable
-> Maybe TvSubst -- A regular one-shot (idempotent) substitution
-- Simple unification of two types; all type variables are bindable
@@ -473,14 +464,13 @@ tcUnifyTysFG bind_fn tys1 tys2
-- Find the fixed point of the resulting non-idempotent substitution
; return (niFixTvSubst subst) }
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Non-idempotent substitution
-%* *
-%************************************************************************
+* *
+************************************************************************
Note [Non-idempotent substitution]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -508,8 +498,8 @@ This happened, for example, in Trac #9106.
This is the reason for extending env with [f:k -> f:*], in the
definition of env' in niFixTvSubst
+-}
-\begin{code}
niFixTvSubst :: TvSubstEnv -> TvSubst
-- Find the idempotent fixed point of the non-idempotent substitution
-- See Note [Finding the substitution fixpoint]
@@ -545,15 +535,15 @@ niSubstTvSet subst tvs
get tv = case lookupVarEnv subst tv of
Nothing -> unitVarSet tv
Just ty -> niSubstTvSet subst (tyVarsOfType ty)
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
The workhorse
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
unify :: TvSubstEnv -- An existing substitution to extend
-> Type -> Type -- Types to be unified, and witness of their equality
-> UM TvSubstEnv -- Just the extended substitution,
@@ -684,30 +674,29 @@ bindTv subst tv ty -- ty is not a type variable
Skolem -> maybeApart subst -- See Note [Unification with skolems]
BindMe -> return $ extendVarEnv subst tv ty
}
-\end{code}
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Binding decisions
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
data BindFlag
= BindMe -- A regular type variable
| Skolem -- This type variable is a skolem constant
-- Don't bind it; it only matches itself
-\end{code}
-
-%************************************************************************
-%* *
+{-
+************************************************************************
+* *
Unification monad
-%* *
-%************************************************************************
+* *
+************************************************************************
+-}
-\begin{code}
newtype UM a = UM { unUM :: (TyVar -> BindFlag)
-> UnifyResultM a }
@@ -740,4 +729,3 @@ maybeApart subst = UM (\_tv_fn -> MaybeApart subst)
surelyApart :: UM a
surelyApart = UM (\_tv_fn -> SurelyApart)
-\end{code}
View Lorry Controller Status