Module header tidyup, phase 1

[ghc-hetmet.git] / compiler / basicTypes / MkId.lhs

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 3e54813..fd4e3e2 100644 (file)
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -1,7 +1,7 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The AQUA Project, Glasgow University, 1998
 %
-\section[StdIdInfo]{Standard unfoldings}
 
 This module contains definitions for the IdInfo for things that
 have a standard form, namely:
@@ -38,72 +38,40 @@ module MkId (
 
 #include "HsVersions.h"
 
-
-import BasicTypes      ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
-import Rules           ( mkSpecInfo )
-import TysPrim         ( openAlphaTyVars, alphaTyVar, alphaTy, 
-                         realWorldStatePrimTy, addrPrimTy
-                       )
-import TysWiredIn      ( charTy, mkListTy )
-import PrelRules       ( primOpRules )
-import Type            ( TyThing(..), mkForAllTy, tyVarsOfTypes, 
-                         newTyConInstRhs, mkTopTvSubst, substTyVar, substTy,
-                         substTys, zipTopTvSubst )
-import TcGadt           ( gadtRefine, refineType, emptyRefinement )
-import HsBinds          ( ExprCoFn(..), isIdCoercion )
-import Coercion         ( mkSymCoercion, mkUnsafeCoercion, isEqPred )
-import TcType          ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy, 
-                         mkTyConApp, mkTyVarTys, mkClassPred, isPredTy,
-                         mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy, tcEqType,
-                         isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
-                         tcSplitFunTys, tcSplitForAllTys, dataConsStupidTheta
-                       )
-import CoreUtils       ( exprType, dataConOrigInstPat, mkCoerce )
-import CoreUnfold      ( mkTopUnfolding, mkCompulsoryUnfolding )
-import Literal         ( nullAddrLit, mkStringLit )
-import TyCon           ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
-                         FieldLabel,
-                          tyConStupidTheta, isProductTyCon, isDataTyCon,
-                          isRecursiveTyCon, isFamInstTyCon,
-                          tyConFamInst_maybe, tyConFamilyCoercion_maybe,
-                          newTyConCo_maybe )
-import Class           ( Class, classTyCon, classSelIds )
-import Var             ( Id, TyVar, Var, setIdType )
-import VarSet          ( isEmptyVarSet, subVarSet, varSetElems )
-import Name            ( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..))
-import OccName         ( mkOccNameFS, varName )
-import PrimOp          ( PrimOp, primOpSig, primOpOcc, primOpTag )
-import ForeignCall     ( ForeignCall )
-import DataCon         ( DataCon, DataConIds(..), dataConTyCon,
-                         dataConUnivTyVars, 
-                         dataConFieldLabels, dataConRepArity, dataConResTys,
-                         dataConRepArgTys, dataConRepType, dataConFullSig,
-                         dataConStrictMarks, dataConExStricts, 
-                         splitProductType, isVanillaDataCon, dataConFieldType,
-                         deepSplitProductType, 
-                       )
-import Id              ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal, 
-                         mkTemplateLocals, mkTemplateLocalsNum, mkExportedLocalId,
-                         mkTemplateLocal, idName
-                       )
-import IdInfo          ( IdInfo, noCafIdInfo,  setUnfoldingInfo, 
-                         setArityInfo, setSpecInfo, setCafInfo,
-                         setAllStrictnessInfo, vanillaIdInfo,
-                         GlobalIdDetails(..), CafInfo(..)
-                       )
-import NewDemand       ( mkStrictSig, DmdResult(..),
-                         mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
-                         Demand(..), Demands(..) )
-import DmdAnal         ( dmdAnalTopRhs )
+import Rules
+import TysPrim
+import TysWiredIn
+import PrelRules
+import Type
+import TcGadt
+import HsBinds
+import Coercion
+import TcType
+import CoreUtils
+import CoreUnfold
+import Literal
+import TyCon
+import Class
+import VarSet
+import Name
+import OccName
+import PrimOp
+import ForeignCall
+import DataCon
+import Id
+import Var              ( Var, TyVar)
+import IdInfo
+import NewDemand
+import DmdAnal
 import CoreSyn
-import Unique          ( mkBuiltinUnique, mkPrimOpIdUnique )
-import Maybe           ( fromJust )
+import Unique
 import Maybes
 import PrelNames
-import Util             ( dropList, isSingleton )
+import BasicTypes       hiding ( SuccessFlag(..) )
+import Util
 import Outputable
 import FastString
-import ListSetOps      ( assoc, minusList )
+import ListSetOps
 \end{code}             
 
 %************************************************************************
@@ -403,16 +371,6 @@ wrapFamInstBody tycon args result_expr
   = mkCoerce (mkSymCoercion (mkTyConApp co_con args)) result_expr
   | otherwise
   = result_expr
-
--- Apply the coercion in the opposite direction.
---
-unwrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
-unwrapFamInstBody tycon args result_expr
-  | Just co_con <- tyConFamilyCoercion_maybe tycon
-  = mkCoerce (mkTyConApp co_con args) result_expr
-  | otherwise
-  = result_expr
-
 \end{code}
 
 
@@ -640,8 +598,8 @@ mkRecordSelId tycon field_label
                -- and apply to (Maybe b'), to get (Maybe b)
 
         rhs = case co_fn of
-               ExprCoFn co -> Cast (Var the_arg_id) co
-               id_co       -> ASSERT(isIdCoercion id_co) Var the_arg_id
+               WpCo co -> Cast (Var the_arg_id) co
+               id_co       -> ASSERT(isIdHsWrapper id_co) Var the_arg_id
 
        field_vs    = filter (not . isPredTy . idType) arg_vs 
        the_arg_id  = assoc "mkRecordSelId:mk_alt" (field_lbls `zip` field_vs) field_label
@@ -906,7 +864,7 @@ mkPrimOpId prim_op
     ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
     name = mkWiredInName gHC_PRIM (primOpOcc prim_op) 
                         (mkPrimOpIdUnique (primOpTag prim_op))
-                        Nothing (AnId id) UserSyntax
+                        (AnId id) UserSyntax
     id   = mkGlobalId (PrimOpId prim_op) name ty info
                
     info = noCafIdInfo
@@ -1045,7 +1003,7 @@ another gun with which to shoot yourself in the foot.
 
 \begin{code}
 mkWiredInIdName mod fs uniq id
- = mkWiredInName mod (mkOccNameFS varName fs) uniq Nothing (AnId id) UserSyntax
+ = mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
 
 unsafeCoerceName = mkWiredInIdName gHC_PRIM FSLIT("unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
 nullAddrName     = mkWiredInIdName gHC_PRIM FSLIT("nullAddr#")    nullAddrIdKey      nullAddrId
@@ -1237,9 +1195,5 @@ pc_bottoming_Id name ty
 
     strict_sig    = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
        -- These "bottom" out, no matter what their arguments
-
-(openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
-openAlphaTy  = mkTyVarTy openAlphaTyVar
-openBetaTy   = mkTyVarTy openBetaTyVar
 \end{code}