Commit 10fdf279 authored by Austin Seipp's avatar Austin Seipp

compiler: de-lhs iface/

Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 0c48e172
%
% (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
-}
\begin{code}
{-# LANGUAGE CPP #-}
module BuildTyCl (
......@@ -41,10 +40,7 @@ import TcRnMonad
import UniqSupply
import Util
import Outputable
\end{code}
\begin{code}
------------------------------------------------------
buildSynonymTyCon :: Name -> [TyVar] -> [Role]
-> Type
......@@ -213,11 +209,9 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
([pat_ty', cont_sigma, _], _) = tcSplitFunTys tau
(ex_tvs', prov_theta', cont_tau) = tcSplitSigmaTy cont_sigma
(arg_tys', _) = tcSplitFunTys cont_tau
\end{code}
-- ------------------------------------------------------
------------------------------------------------------
\begin{code}
type TcMethInfo = (Name, DefMethSpec, Type)
-- A temporary intermediate, to communicate between
-- tcClassSigs and buildClass.
......@@ -319,8 +313,8 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
VanillaDM -> do { dm_name <- newImplicitBinder op_name mkDefaultMethodOcc
; return (DefMeth dm_name) }
; return (mkDictSelId op_name rec_clas, dm_info) }
\end{code}
{-
Note [Class newtypes and equality predicates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
......@@ -336,3 +330,4 @@ Moreover,
Here we can't use a newtype either, even though there is only
one field, because equality predicates are unboxed, and classes
are boxed.
-}
(c) The University of Glasgow 2002-2006
-- (c) The University of Glasgow 2002-2006
\begin{code}
{-# LANGUAGE CPP, RankNTypes #-}
module IfaceEnv (
......@@ -38,14 +37,13 @@ import Outputable
import Exception ( evaluate )
import Data.IORef ( atomicModifyIORef, readIORef )
\end{code}
%*********************************************************
%* *
{-
*********************************************************
* *
Allocating new Names in the Name Cache
%* *
%*********************************************************
* *
*********************************************************
Note [The Name Cache]
~~~~~~~~~~~~~~~~~~~~~
......@@ -61,9 +59,8 @@ External Name "M.x" has one, and only one globally-agreed Unique.
The functions newGlobalBinder, allocateGlobalBinder do the main work.
When you make an External name, you should probably be calling one
of them.
-}
\begin{code}
newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
-- Used for source code and interface files, to make the
-- Name for a thing, given its Module and OccName
......@@ -165,13 +162,13 @@ lookupOrig mod occ
new_cache = extendNameCache (nsNames name_cache) mod occ name
in (name_cache{ nsUniqs = us, nsNames = new_cache }, name)
}}}
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Name cache access
%* *
%************************************************************************
* *
************************************************************************
See Note [The Name Cache] above.
......@@ -192,8 +189,8 @@ However, there are two reasons why we might look up an Orig RdrName:
(DsMeta.globalVar), and parses a NameG into an Orig RdrName
(Convert.thRdrName). So, eg $(do { reify '(,); ... }) will
go this route (Trac #8954).
-}
\begin{code}
lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache nc mod occ
| Just name <- isBuiltInOcc_maybe occ
......@@ -240,10 +237,7 @@ mkNameCacheUpdater = do
_ <- evaluate =<< readIORef nc_var
return r
return (NCU update_nc)
\end{code}
\begin{code}
initNameCache :: UniqSupply -> [Name] -> NameCache
initNameCache us names
= NameCache { nsUniqs = us,
......@@ -251,17 +245,15 @@ initNameCache us names
initOrigNames :: [Name] -> OrigNameCache
initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Type variables and local Ids
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
tcIfaceLclId :: FastString -> IfL Id
tcIfaceLclId occ
= do { lcl <- getLclEnv
......@@ -297,16 +289,15 @@ extendIfaceTyVarEnv tyvars thing_inside
; let { tv_env' = addListToUFM (if_tv_env env) pairs
; pairs = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Getting from RdrNames to Names
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
lookupIfaceTop :: OccName -> IfL Name
-- Look up a top-level name from the current Iface module
lookupIfaceTop occ
......@@ -322,4 +313,3 @@ newIfaceNames occs
= do { uniqs <- newUniqueSupply
; return [ mkInternalName uniq occ noSrcSpan
| (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-}
\begin{code}
{-# LANGUAGE CPP #-}
module IfaceSyn (
......@@ -63,16 +62,15 @@ import System.IO.Unsafe
import Data.Maybe (isJust)
infixl 3 &&&
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Declarations
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
type IfaceTopBndr = OccName
-- It's convenient to have an OccName in the IfaceSyn, altough in each
-- case the namespace is implied by the context. However, having an
......@@ -300,29 +298,26 @@ data IfaceIdDetails
= IfVanillaId
| IfRecSelId IfaceTyCon Bool
| IfDFunId Int -- Number of silent args
\end{code}
{-
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
%************************************************************************
%* *
************************************************************************
* *
Functions over declarations
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls (IfAbstractTyCon {}) = []
visibleIfConDecls IfDataFamTyCon = []
visibleIfConDecls (IfDataTyCon cs) = cs
visibleIfConDecls (IfNewTyCon c) = [c]
\end{code}
\begin{code}
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
-- *Excludes* the 'main' name, but *includes* the implicitly-bound names
-- Deeply revolting, because it has to predict what gets bound,
......@@ -403,15 +398,15 @@ ifaceDeclFingerprints hash decl
computeFingerprint' =
unsafeDupablePerformIO
. computeFingerprint (panic "ifaceDeclFingerprints")
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Expressions
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
data IfaceExpr
= IfaceLcl IfLclName
| IfaceExt IfExtName
......@@ -450,8 +445,8 @@ data IfaceBinding
-- It's used for *non-top-level* let/rec binders
-- See Note [IdInfo on nested let-bindings]
data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
\end{code}
{-
Note [Empty case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In IfaceSyn an IfaceCase does not record the types of the alternatives,
......@@ -476,13 +471,13 @@ In general we retain all info that is left by CoreTidy.tidyLetBndr, since
that is what is seen by importing module with --make
%************************************************************************
%* *
************************************************************************
* *
Printing IfaceDecl
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc
-- The TyCon might be local (just an OccName), or this might
-- be a branch for an imported TyCon, so it would be an ExtName
......@@ -544,8 +539,8 @@ showSub :: HasOccName n => ShowSub -> n -> Bool
showSub (ShowSub { ss_how_much = ShowHeader }) _ = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) }) thing = n == occName thing
showSub (ShowSub { ss_how_much = _ }) _ = True
\end{code}
{-
Note [Printing IfaceDecl binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The binders in an IfaceDecl are just OccNames, so we don't know what module they
......@@ -556,8 +551,8 @@ binders.
When printing an interface file (--show-iface), we want to print
everything unqualified, so we can just print the OccName directly.
-}
\begin{code}
ppr_trim :: [Maybe SDoc] -> [SDoc]
-- Collapse a group of Nothings to a single "..."
ppr_trim xs
......@@ -860,8 +855,8 @@ instance Outputable IfaceFamInst where
ppr_rough :: Maybe IfaceTyCon -> SDoc
ppr_rough Nothing = dot
ppr_rough (Just tc) = ppr tc
\end{code}
{-
Note [Result type of a data family GADT]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
......@@ -884,8 +879,8 @@ Remember that in IfaceSyn, the TyCon and DataCon share the same
universal type variables.
----------------------------- Printing IfaceExpr ------------------------------------
-}
\begin{code}
instance Outputable IfaceExpr where
ppr e = pprIfaceExpr noParens e
......@@ -1021,13 +1016,13 @@ instance Outputable IfaceUnfolding where
pprParendIfaceExpr e]
ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot)
2 (sep (map pprParendIfaceExpr es))
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Finding the Names in IfaceSyn
%* *
%************************************************************************
* *
************************************************************************
This is used for dependency analysis in MkIface, so that we
fingerprint a declaration before the things that depend on it. It
......@@ -1035,8 +1030,8 @@ is specific to interface-file fingerprinting in the sense that we
don't collect *all* Names: for example, the DFun of an instance is
recorded textually rather than by its fingerprint when
fingerprinting the instance, so DFuns are not dependencies.
-}
\begin{code}
freeNamesIfDecl :: IfaceDecl -> NameSet
freeNamesIfDecl (IfaceId _s t d i) =
freeNamesIfType t &&&
......@@ -1269,8 +1264,8 @@ freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
fnList :: (a -> NameSet) -> [a] -> NameSet
fnList f = foldr (&&&) emptyNameSet . map f
\end{code}
{-
Note [Tracking data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In a case expression
......@@ -1297,13 +1292,13 @@ on the *locally-defined* type PackageState is not visible. We need
to take account of the use of the data constructor PS in the pattern match.
%************************************************************************
%* *
************************************************************************
* *
Binary instances
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
instance Binary IfaceDecl where
put_ bh (IfaceId name ty details idinfo) = do
putByte bh 0
......@@ -1839,4 +1834,3 @@ instance Binary IfaceTyConParent where
pr <- get bh
ty <- get bh
return $ IfDataInstance ax pr ty
\end{code}
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
This module defines interface types and binders
-}
\begin{code}
{-# LANGUAGE CPP #-}
module IfaceType (
IfExtName, IfLclName,
......@@ -65,15 +65,15 @@ import Outputable
import FastString
import UniqSet
import Data.Maybe( fromMaybe )
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Local (nested) binders
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
type IfLclName = FastString -- A local name in iface syntax
type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn
......@@ -150,17 +150,14 @@ data IfaceCoercion
| IfaceSubCo IfaceCoercion
| IfaceAxiomRuleCo IfLclName [IfaceType] [IfaceCoercion]
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Functions over IFaceTypes
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], [IfacePredType], IfaceType)
-- Mainly for printing purposes
splitIfaceSigmaTy ty
......@@ -219,13 +216,13 @@ ifTyVarsOfArgs args = argv emptyUniqSet args
argv vs (ITC_Type t ts) = argv (vs `unionUniqSets` (ifTyVarsOfType t)) ts
argv vs (ITC_Kind k ks) = argv (vs `unionUniqSets` (ifTyVarsOfType k)) ks
argv vs ITC_Nil = vs
\end{code}
{-
Substitutions on IfaceType. This is only used during pretty-printing to construct
the result type of a GADT, and does not deal with binders (eg IfaceForAll), so
it doesn't need fancy capture stuff.
-}
\begin{code}
type IfaceTySubst = FastStringEnv IfaceType
mkIfaceTySubst :: [IfaceTvBndr] -> [IfaceType] -> IfaceTySubst
......@@ -255,16 +252,15 @@ substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar env tv
| Just ty <- lookupFsEnv env tv = ty
| otherwise = IfaceTyVar tv
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Functions over IFaceTcArgs
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
stripKindArgs :: DynFlags -> IfaceTcArgs -> IfaceTcArgs
stripKindArgs dflags tys
| gopt Opt_PrintExplicitKinds dflags = tys
......@@ -290,8 +286,8 @@ tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
tcArgsIfaceTypes ITC_Nil = []
tcArgsIfaceTypes (ITC_Kind t ts) = t : tcArgsIfaceTypes ts
tcArgsIfaceTypes (ITC_Type t ts) = t : tcArgsIfaceTypes ts
\end{code}
{-
Note [Suppressing kinds]
~~~~~~~~~~~~~~~~~~~~~~~~
We use the IfaceTcArgs to specify which of the arguments to a type
......@@ -306,24 +302,25 @@ we want
'Just * prints as Just *
%************************************************************************
%* *
************************************************************************
* *
Functions over IFaceTyCon
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
--isPromotedIfaceTyCon :: IfaceTyCon -> Bool
--isPromotedIfaceTyCon (IfacePromotedTyCon _) = True
--isPromotedIfaceTyCon _ = False
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Pretty-printing
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
pprIfaceInfixApp :: (TyPrec -> a -> SDoc) -> TyPrec -> SDoc -> a -> a -> SDoc
pprIfaceInfixApp pp p pp_tc ty1 ty2
= maybeParen p FunPrec $
......@@ -334,12 +331,9 @@ pprIfacePrefixApp p pp_fun pp_tys
| null pp_tys = pp_fun
| otherwise = maybeParen p TyConPrec $
hang pp_fun 2 (sep pp_tys)
\end{code}
-- ----------------------------- Printing binders ------------------------------------
----------------------------- Printing binders ------------------------------------
\begin{code}
instance Outputable IfaceBndr where
ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
......@@ -387,11 +381,9 @@ instance Binary IfaceOneShot where
case h of
0 -> do return IfaceNoOneShot
_ -> do return IfaceOneShot
\end{code}
----------------------------- Printing IfaceType ------------------------------------
-- ----------------------------- Printing IfaceType ------------------------------------
\begin{code}
---------------------------------
instance Outputable IfaceType where
ppr ty = pprIfaceType ty
......@@ -881,15 +873,14 @@ instance Binary IfaceCoercion where
return $ IfaceAxiomRuleCo a b c
_ -> panic ("get IfaceCoercion " ++ show tag)
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
Conversion from Type to IfaceType
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
----------------
toIfaceTvBndr :: TyVar -> (IfLclName, IfaceType)
toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
......@@ -978,4 +969,3 @@ toIfaceCoercion (AxiomRuleCo co ts cs) = IfaceAxiomRuleCo
(coaxrName co)
(map toIfaceType ts)
(map toIfaceCoercion cs)
\end{code}
%
% (c) The University of Glasgow 2006-2008
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
{-
(c) The University of Glasgow 2006-2008
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-}
\begin{code}
{-# LANGUAGE CPP, NondecreasingIndentation #-}
-- | Module for constructing @ModIface@ values (interface files),
......@@ -25,8 +24,8 @@ module MkIface (
tyThingToIfaceDecl -- Converting things to their Iface equivalents
) where
\end{code}
{-
-----------------------------------------------
Recompilation checking
-----------------------------------------------
......@@ -56,8 +55,8 @@ Basic idea:
* In checkOldIface we compare the mi_usages for the module with
the actual fingerprint for all each thing recorded in mi_usages
-}
\begin{code}
#include "HsVersions.h"
import IfaceSyn
......@@ -123,17 +122,15 @@ import Data.Ord
import Data.IORef
import System.Directory
import System.FilePath
\end{code}
%************************************************************************
%* *
{-
************************************************************************
* *
\subsection{Completing an interface}
%* *
%************************************************************************
* *
************************************************************************
-}
\begin{code}
mkIface :: HscEnv
-> Maybe Fingerprint -- The old fingerprint, if we have it
-> ModDetails -- The trimmed, tidied interface
......@@ -669,10 +666,7 @@ sortDependencies d
dep_pkgs = sortBy (stablePackageKeyCmp `on` fst) (dep_pkgs d),
dep_orphs = sortBy stableModuleCmp (dep_orphs d),
dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
\end{code}
\begin{code}
-- | Creates cached lookup for the 'mi_anns' field of ModIface
-- Hackily, we use "module" as the OccName for any module-level annotations
mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
......@@ -686,8 +680,8 @@ mkIfaceAnnCache anns
, [value])
-- flipping (++), so the first argument is always short
env = mkOccEnv_C (flip (++)) (map pair anns)
\end{code}