[commit: ghc] master: Make SpecConstr also check for GHC.Types.SPEC (cee3adb)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cee3adbcc180bdf1be8b24aeaafa2ca4a737cbbf/ghc

>---------------------------------------------------------------

commit cee3adbcc180bdf1be8b24aeaafa2ca4a737cbbf
Author: Austin Seipp <austin at well-typed.com>
Date:   Fri Oct 25 06:13:27 2013 -0500

    Make SpecConstr also check for GHC.Types.SPEC
    
    SpecConstr has for a while now looked for types with the built
    in ForceSpecConstr annotation, in order to know where to be particularly
    aggressive.
    
    Unfortunately using an annotation has a number of downsides, the most
    prominent two being:
    
      A) ForceSpecConstr is vital for efficiency (even if it's
         a hack), but it means users of it must have GHCI - even though
         stage2 features are not required for anything but the annotation.
    
      B) Any user who might need it (read: vector) has to duplicate the same
         piece of code. In general there are few people actually doing this,
         but it's unclear why they should have to.
    
    This patch makes SpecConstr look for functions applied to the new
    GHC.Types.SPEC type - a copy of the already-extant 'SPEC' type - as well
    as look for annotations, in the stage2 compiler.
    
    In particular, this means `vector` can now be built with a stage1
    compiler, since it no longer depends on stage2 for anything else. This
    is particularly important for e.g. iOS cross-compilers.
    
    This also means we should be able to build `vector` earlier in the build
    process too, but this patch doesn't address that.
    
    This requires an accompanying bump in ghc-prim.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


>---------------------------------------------------------------

cee3adbcc180bdf1be8b24aeaafa2ca4a737cbbf
 compiler/prelude/PrelNames.lhs     |   16 ++++++++++++----
 compiler/specialise/SpecConstr.lhs |   14 ++++++++------
 2 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 7d15614..6223567 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -305,6 +305,9 @@ basicKnownKeyNames
         -- The Ordering type
         , orderingTyConName, ltDataConName, eqDataConName, gtDataConName
 
+        -- The SPEC type for SpecConstr
+        , specTyConName
+
         -- The Either type
         , eitherTyConName, leftDataConName, rightDataConName
 
@@ -743,9 +746,12 @@ runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
 
 orderingTyConName, ltDataConName, eqDataConName, gtDataConName :: Name
 orderingTyConName = tcQual   gHC_TYPES (fsLit "Ordering") orderingTyConKey
-ltDataConName = conName gHC_TYPES (fsLit "LT") ltDataConKey
-eqDataConName = conName gHC_TYPES (fsLit "EQ") eqDataConKey
-gtDataConName = conName gHC_TYPES (fsLit "GT") gtDataConKey
+ltDataConName     = conName gHC_TYPES (fsLit "LT") ltDataConKey
+eqDataConName     = conName gHC_TYPES (fsLit "EQ") eqDataConKey
+gtDataConName     = conName gHC_TYPES (fsLit "GT") gtDataConKey
+
+specTyConName :: Name
+specTyConName     = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey
 
 eitherTyConName, leftDataConName, rightDataConName :: Name
 eitherTyConName   = tcQual  dATA_EITHER (fsLit "Either") eitherTyConKey
@@ -840,7 +846,6 @@ pureAClassOpKey     = mkPreludeMiscIdUnique 752
 alternativeClassKey = mkPreludeMiscIdUnique 753
 
 
-
 -- Functions for GHC extensions
 groupWithName :: Name
 groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey
@@ -1489,6 +1494,9 @@ coercibleTyConKey = mkPreludeTyConUnique 175
 proxyPrimTyConKey :: Unique
 proxyPrimTyConKey = mkPreludeTyConUnique 176
 
+specTyConKey :: Unique
+specTyConKey = mkPreludeTyConUnique 177
+
 ---------------- Template Haskell -------------------
 --      USES TyConUniques 200-299
 -----------------------------------------------------
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 0518367..c4b46aa 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -53,13 +53,13 @@ import UniqFM
 import MonadUtils
 import Control.Monad    ( zipWithM )
 import Data.List
-
+import TyCon            ( TyCon, tyConName )
+import PrelNames        ( specTyConName )
 
 -- See Note [SpecConstrAnnotation]
 #ifndef GHCI
 type SpecConstrAnnotation = ()
 #else
-import TyCon            ( TyCon )
 import GHC.Exts( SpecConstrAnnotation(..) )
 #endif
 \end{code}
@@ -910,11 +910,10 @@ decreaseSpecCount env n_specs
 ignoreType    :: ScEnv -> Type   -> Bool
 ignoreDataCon  :: ScEnv -> DataCon -> Bool
 forceSpecBndr :: ScEnv -> Var    -> Bool
+
 #ifndef GHCI
 ignoreType    _ _  = False
 ignoreDataCon  _ _ = False
-forceSpecBndr _ _  = False
-
 #else /* GHCI */
 
 ignoreDataCon env dc = ignoreTyCon env (dataConTyCon dc)
@@ -927,6 +926,7 @@ ignoreType env ty
 ignoreTyCon :: ScEnv -> TyCon -> Bool
 ignoreTyCon env tycon
   = lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
+#endif /* GHCI */
 
 forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTys . varType $ var
 
@@ -940,11 +940,13 @@ forceSpecArgTy env ty
 forceSpecArgTy env ty
   | Just (tycon, tys) <- splitTyConApp_maybe ty
   , tycon /= funTyCon
-      = lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
+      = tyConName tycon == specTyConName
+#ifdef GHCI
+        || lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
+#endif
         || any (forceSpecArgTy env) tys
 
 forceSpecArgTy _ _ = False
-#endif /* GHCI */
 \end{code}
 
 Note [Add scrutinee to ValueEnv too]