Take account of the mk_integer in a LitInteger when computing CAF-hood
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 23 Sep 2011 05:13:30 +0000 (06:13 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 23 Sep 2011 05:16:35 +0000 (06:16 +0100)
This is a follow-on to Ian's Integer-literal patch.
In effect the mk_integer Id is a free variable of a LitInteger literal.

I've also added some comments (Note [Integer literals]) in Literal.

compiler/basicTypes/Literal.lhs
compiler/coreSyn/CorePrep.lhs
compiler/main/TidyPgm.lhs

index 00b3770..8c5d42a 100644 (file)
@@ -110,15 +110,32 @@ data Literal
                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                 --    be appended to label name when emitting assembly.
 
-  | LitInteger Integer Id
-   -- ^ We treat @Integer@s as literals, to make it easier to write
-   --   RULEs for them. They only get converted into real Core during
-   --   the CorePrep phase.
-   --   The Id is for mkInteger, which we use when finally creating the
-   --   core.
+  | LitInteger Integer Id      --  ^ Integer literals
+                               -- See Note [Integer literals]
   deriving (Data, Typeable)
 \end{code}
 
+Note [Integer literals]
+~~~~~~~~~~~~~~~~~~~~~~~
+An Integer literal is represented using, well, an Integer, to make it
+easier to write RULEs for them. 
+
+ * The Id is for mkInteger, which we use when finally creating the core.
+
+ * They only get converted into real Core,
+      mkInteger [c1, c2, .., cn]
+   during the CorePrep phase.
+
+ * When we initally build an Integer literal, notably when
+   deserialising it from an interface file (see the Binary instance
+   below), we don't have convenient access to the mkInteger Id.  So we
+   just use an error thunk, and fill in the real Id when we do tcIfaceLit
+   in TcIface.
+
+ * When looking for CAF-hood (in TidyPgm), we must take account of the
+   CAF-hood of the mk_integer field in LitInteger; see TidyPgm.cafRefsL
+
+
 Binary instance
 
 \begin{code}
@@ -175,6 +192,7 @@ instance Binary Literal where
               _ -> do
                     i <- get bh
                     return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
+                          -- See Note [Integer literals] in Literal
 \end{code}
 
 \begin{code}
index e268cc2..718a38c 100644 (file)
@@ -451,8 +451,8 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
 
 cpeRhsE _env expr@(Type {})      = return (emptyFloats, expr)
 cpeRhsE _env expr@(Coercion {})  = return (emptyFloats, expr)
-cpeRhsE env (Lit (LitInteger i mkIntegerId))
-    = cpeRhsE env (cvtLitInteger i mkIntegerId)
+cpeRhsE env (Lit (LitInteger i mk_integer))
+    = cpeRhsE env (cvtLitInteger i mk_integer)
 cpeRhsE _env expr@(Lit {})       = return (emptyFloats, expr)
 cpeRhsE env expr@(Var {})        = cpeApp env expr
 
@@ -507,11 +507,14 @@ cvtLitInteger :: Integer -> Id -> CoreExpr
 -- represenation. Exactly how we do this depends on the
 -- library that implements Integer.  If it's GMP we 
 -- use the S# data constructor for small literals.  
-cvtLitInteger i mkIntegerId
-  | cIntegerLibraryType == IntegerGMP && inIntRange i
+-- See Note [Integer literals] in Literal
+cvtLitInteger i mk_integer
+  | cIntegerLibraryType == IntegerGMP
+  , inIntRange i       -- Special case for small integers in GMP
     = mkConApp integerGmpSDataCon [Lit (mkMachInt i)]
+
   | otherwise
-    = mkApps (Var mkIntegerId) [isNonNegative, ints]
+    = mkApps (Var mk_integer) [isNonNegative, ints]
   where isNonNegative = if i < 0 then mkConApp falseDataCon []
                                  else mkConApp trueDataCon  []
         ints = mkListExpr intTy (f (abs i))
index 2d90c2c..95a0871 100644 (file)
@@ -18,6 +18,7 @@ import CoreFVs
 import CoreTidy
 import CoreMonad
 import CoreUtils
+import Literal
 import Rules
 import CoreArity       ( exprArity, exprBotStrictness_maybe )
 import VarEnv
@@ -1187,7 +1188,7 @@ hasCafRefs this_pkg p arity expr
   | is_caf || mentions_cafs = MayHaveCafRefs
   | otherwise              = NoCafRefs
  where
-  mentions_cafs = isFastTrue (cafRefs p expr)
+  mentions_cafs = isFastTrue (cafRefsE p expr)
   is_dynamic_name = isDllName this_pkg 
   is_caf = not (arity > 0 || rhsIsStatic is_dynamic_name expr)
 
@@ -1197,29 +1198,33 @@ hasCafRefs this_pkg p arity expr
   -- CorePrep later on, and we don't want to duplicate that
   -- knowledge in rhsIsStatic below.
 
-cafRefs :: VarEnv Id -> Expr a -> FastBool
-cafRefs p (Var id)
-       -- imported Ids first:
-  | not (isLocalId id) = fastBool (mayHaveCafRefs (idCafInfo id))
-       -- now Ids local to this module:
-  | otherwise =
-     case lookupVarEnv p id of
-       Just id' -> fastBool (mayHaveCafRefs (idCafInfo id'))
-       Nothing  -> fastBool False
-
-cafRefs _ (Lit _)             = fastBool False
-cafRefs p (App f a)           = fastOr (cafRefs p f) (cafRefs p) a
-cafRefs p (Lam _ e)           = cafRefs p e
-cafRefs p (Let b e)           = fastOr (cafRefss p (rhssOfBind b)) (cafRefs p) e
-cafRefs p (Case e _bndr _ alts) = fastOr (cafRefs p e) (cafRefss p) (rhssOfAlts alts)
-cafRefs p (Note _n e)         = cafRefs p e
-cafRefs p (Cast e _co)         = cafRefs p e
-cafRefs _ (Type _)            = fastBool False
-cafRefs _ (Coercion _)         = fastBool False
-
-cafRefss :: VarEnv Id -> [Expr a] -> FastBool
-cafRefss _ []    = fastBool False
-cafRefss p (e:es) = fastOr (cafRefs p e) (cafRefss p) es
+cafRefsE :: VarEnv Id -> Expr a -> FastBool
+cafRefsE p (Var id)            = cafRefsV p id
+cafRefsE p (Lit lit)          = cafRefsL p lit
+cafRefsE p (App f a)          = fastOr (cafRefsE p f) (cafRefsE p) a
+cafRefsE p (Lam _ e)          = cafRefsE p e
+cafRefsE p (Let b e)          = fastOr (cafRefsEs p (rhssOfBind b)) (cafRefsE p) e
+cafRefsE p (Case e _bndr _ alts) = fastOr (cafRefsE p e) (cafRefsEs p) (rhssOfAlts alts)
+cafRefsE p (Note _n e)                = cafRefsE p e
+cafRefsE p (Cast e _co)         = cafRefsE p e
+cafRefsE _ (Type _)           = fastBool False
+cafRefsE _ (Coercion _)         = fastBool False
+
+cafRefsEs :: VarEnv Id -> [Expr a] -> FastBool
+cafRefsEs _ []           = fastBool False
+cafRefsEs p (e:es) = fastOr (cafRefsE p e) (cafRefsEs p) es
+
+cafRefsL :: VarEnv Id -> Literal -> FastBool
+-- Don't forget that the embeded mk_integer id might have Caf refs!
+-- See Note [Integer literals] in Literal
+cafRefsL p (LitInteger _ mk_integer) = cafRefsV p mk_integer
+cafRefsL _ _                         = fastBool False
+
+cafRefsV :: VarEnv Id -> Id -> FastBool
+cafRefsV p id 
+  | not (isLocalId id)            = fastBool (mayHaveCafRefs (idCafInfo id))
+  | Just id' <- lookupVarEnv p id = fastBool (mayHaveCafRefs (idCafInfo id'))
+  | otherwise                     = fastBool False
 
 fastOr :: FastBool -> (a -> FastBool) -> a -> FastBool
 -- hack for lazy-or over FastBool.