Big tidy-up of deriving code

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

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 88d889a..741ca58 100644 (file)
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -18,7 +18,7 @@ module MkId (
 
        mkDataConIds,
        mkRecordSelId, 
-       mkPrimOpId, mkFCallId,
+       mkPrimOpId, mkFCallId, mkTickBoxOpId, 
 
        mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
         mkUnpackCase, mkProductBox,
@@ -72,6 +72,7 @@ import Util
 import Outputable
 import FastString
 import ListSetOps
+import Module
 \end{code}             
 
 %************************************************************************
@@ -217,7 +218,7 @@ mkDataConIds wrap_name wkr_name data_con
                     -- arguments to the universals of the data constructor
                     -- (crucial when type checking interfaces)
     dict_tys       = mkPredTys theta
-    result_ty_args = map (substTyVar subst) univ_tvs
+    result_ty_args = substTyVars subst univ_tvs
     result_ty      = case tyConFamInst_maybe tycon of
                         -- ordinary constructor
                       Nothing            -> mkTyConApp tycon result_ty_args
@@ -246,6 +247,7 @@ mkDataConIds wrap_name wkr_name data_con
                                                        -- even if arity = 0
 
     wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
+       --      Note [Data-con worker strictness]
        -- Notice that we do *not* say the worker is strict
        -- even if the data constructor is declared strict
        --      e.g.    data T = MkT !(Int,Int)
@@ -902,6 +904,18 @@ mkFCallId uniq fcall ty
     (arg_tys, _) = tcSplitFunTys tau
     arity       = length arg_tys
     strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
+
+mkTickBoxOpId :: Unique 
+             -> Module
+             -> TickBoxId
+             -> Id
+mkTickBoxOpId uniq mod ix =  mkGlobalId (TickBoxOpId tickbox) name ty info    
+  where
+    tickbox = TickBox mod ix
+    occ_str = showSDoc (braces (ppr tickbox))
+    name    = mkTickBoxOpName uniq occ_str
+    info    = noCafIdInfo
+    ty      = realWorldStatePrimTy 
 \end{code}
 
 
@@ -1036,8 +1050,7 @@ unsafeCoerceId
                      (mkFunTy openAlphaTy openBetaTy)
     [x] = mkTemplateLocals [openAlphaTy]
     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
---       Note (Coerce openBetaTy openAlphaTy) (Var x)
-         Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
+          Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
 
 -- nullAddr# :: Addr#
 -- The reason is is here is because we don't provide