X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FMkId.lhs;h=b7c442b4cb387155b6220a0398977a219d066ef1;hb=361475818720689fb0a83fffd0138d1363da8b70;hp=d0725bf502857951c6729d97d9ea39293ee885ce;hpb=215ce9f15215399ce30ae55c9521087847d78646;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index d0725bf..b7c442b 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -12,13 +12,6 @@ have a standard form, namely:
 - primitive operations
 
 \begin{code}
-{-# OPTIONS -fno-warn-missing-signatures #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---  <http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings>
--- for details
-
 module MkId (
         mkDictFunId, mkDefaultMethodId,
         mkDictSelId, 
@@ -225,10 +218,8 @@ It's a bit more complicated if the data instance is a GADT as well!
 
    data instance T [a] where
         T1 :: forall b. b -> T [Maybe b]
-Hence
-   Co7T a :: T [a] ~ :R7T a
 
-Now we want
+Hence we translate to
 
         -- Wrapper
   $WT1 :: forall b. b -> T [Maybe b]
@@ -238,6 +229,9 @@ Now we want
         -- Worker
   T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
 
+        -- Coercion from family type to representation type
+  Co7T a :: T [a] ~ :R7T a
+
 \begin{code}
 mkDataConIds :: Name -> Name -> DataCon -> DataConIds
 mkDataConIds wrap_name wkr_name data_con
@@ -399,6 +393,7 @@ mAX_CPR_SIZE = 10
 --         by the caller.  So doing CPR for them may in fact make
 --         things worse.
 
+mkLocals :: Int -> [Type] -> ([Id], Int)
 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
                where
                  n = length tys
@@ -806,6 +801,7 @@ mkBreakPointOpId :: Unique -> Module -> TickBoxId -> Id
 mkBreakPointOpId uniq mod ix = mkTickBox' uniq mod ix ty
  where ty = mkSigmaTy [openAlphaTyVar] [] openAlphaTy
 
+mkTickBox' :: Unique -> Module -> TickBoxId -> Type -> Id
 mkTickBox' uniq mod ix ty = mkGlobalId (TickBoxOpId tickbox) name ty info    
   where
     tickbox = TickBox mod ix
@@ -846,7 +842,10 @@ BUT make sure they are *exported* LocalIds (mkExportedLocalId) so
 that they aren't discarded by the occurrence analyser.
 
 \begin{code}
-mkDefaultMethodId dm_name ty = mkExportedLocalId dm_name ty
+mkDefaultMethodId :: Id		-- Selector Id
+		  -> Name	-- Default method name
+		  -> Id		-- Default method Id
+mkDefaultMethodId sel_id dm_name = mkExportedLocalId dm_name (idType sel_id)
 
 mkDictFunId :: Name      -- Name to use for the dict fun;
             -> [TyVar]
@@ -885,9 +884,14 @@ they can unify with both unlifted and lifted types.  Hence we provide
 another gun with which to shoot yourself in the foot.
 
 \begin{code}
+mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
 mkWiredInIdName mod fs uniq id
  = mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
 
+unsafeCoerceName, nullAddrName, seqName, realWorldName :: Name
+lazyIdName, errorName, recSelErrorName, runtimeErrorName :: Name
+irrefutPatErrorName, recConErrorName, patErrorName :: Name
+nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name
 unsafeCoerceName = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
 nullAddrName     = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#")     nullAddrIdKey      nullAddrId
 seqName          = mkWiredInIdName gHC_PRIM (fsLit "seq")           seqIdKey           seqId
@@ -910,17 +914,18 @@ nonExhaustiveGuardsErrorName
 \begin{code}
 ------------------------------------------------
 -- unsafeCoerce# :: forall a b. a -> b
+unsafeCoerceId :: Id
 unsafeCoerceId
   = pcMiscPrelId unsafeCoerceName ty info
   where
     info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
            
 
-    ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
-                      (mkFunTy openAlphaTy openBetaTy)
-    [x] = mkTemplateLocals [openAlphaTy]
-    rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
-          Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
+    ty  = mkForAllTys [argAlphaTyVar,openBetaTyVar]
+                      (mkFunTy argAlphaTy openBetaTy)
+    [x] = mkTemplateLocals [argAlphaTy]
+    rhs = mkLams [argAlphaTyVar,openBetaTyVar,x] $
+          Cast (Var x) (mkUnsafeCoercion argAlphaTy openBetaTy)
 
 ------------------------------------------------
 nullAddrId :: Id
@@ -1051,6 +1056,7 @@ E.g.
 This comes up in strictness analysis
 
 \begin{code}
+realWorldPrimId :: Id
 realWorldPrimId -- :: State# RealWorld
   = pcMiscPrelId realWorldName realWorldStatePrimTy
                  (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
@@ -1103,6 +1109,8 @@ mkImpossibleExpr :: Type -> CoreExpr
 mkImpossibleExpr res_ty
   = mkRuntimeErrorApp rUNTIME_ERROR_ID res_ty "Impossible case alternative"
 
+rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, iRREFUT_PAT_ERROR_ID, rEC_CON_ERROR_ID :: Id
+pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
 rEC_SEL_ERROR_ID                = mkRuntimeErrorId recSelErrorName
 rUNTIME_ERROR_ID                = mkRuntimeErrorId runtimeErrorName
 iRREFUT_PAT_ERROR_ID            = mkRuntimeErrorId irrefutPatErrorName
@@ -1121,6 +1129,7 @@ runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
 \end{code}
 
 \begin{code}
+eRROR_ID :: Id
 eRROR_ID = pc_bottoming_Id errorName errorTy
 
 errorTy  :: Type