Merge branch 'refs/heads/vect-avoid' into vect-avoid-merge
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>
Tue, 5 Feb 2013 23:31:17 +0000 (10:31 +1100)
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Tue, 5 Feb 2013 23:31:17 +0000 (10:31 +1100)
Conflicts:
compiler/rename/RnSource.lhs
compiler/simplCore/OccurAnal.lhs
compiler/vectorise/Vectorise/Exp.hs

NB: Merging instead of rebasing for a change. During rebase Git got confused due to the lack of the submodules in my quite old fork.

22 files changed:
1  2 
compiler/coreSyn/CoreSubst.lhs
compiler/coreSyn/CoreSyn.lhs
compiler/coreSyn/PprCore.lhs
compiler/deSugar/Desugar.lhs
compiler/hsSyn/HsDecls.lhs
compiler/iface/LoadIface.lhs
compiler/iface/MkIface.lhs
compiler/iface/TcIface.lhs
compiler/main/DynFlags.hs
compiler/main/HscTypes.lhs
compiler/main/TidyPgm.lhs
compiler/parser/Parser.y.pp
compiler/rename/RnSource.lhs
compiler/simplCore/OccurAnal.lhs
compiler/simplCore/SimplCore.lhs
compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcHsSyn.lhs
compiler/vectorise/Vectorise.hs
compiler/vectorise/Vectorise/Env.hs
compiler/vectorise/Vectorise/Exp.hs
compiler/vectorise/Vectorise/Monad/InstEnv.hs
compiler/vectorise/Vectorise/Type/Env.hs

Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
@@@ -2452,8 -2029,9 +2452,8 @@@ fFlags = 
    ( "print-bind-contents",              Opt_PrintBindContents, nop ),
    ( "run-cps",                          Opt_RunCPS, nop ),
    ( "run-cpsz",                         Opt_RunCPSZ, nop ),
 -  ( "new-codegen",                      Opt_TryNewCodeGen, nop ),
    ( "vectorise",                        Opt_Vectorise, nop ),
-   ( "avoid-vect",                       Opt_AvoidVect, nop ),
+   ( "vectorisation-avoidance",          Opt_VectorisationAvoidance, nop ),
    ( "regs-graph",                       Opt_RegsGraph, nop ),
    ( "regs-iterative",                   Opt_RegsIterative, nop ),
    ( "llvm-tbaa",                        Opt_LlvmTBAA, nop), -- hidden flag
Simple merge
@@@ -464,40 -559,16 +464,43 @@@ tidyVectInfo (_, var_env) info@(VectInf
                           , isDataConWorkId var || not (isImplicitId var)
                           ]
  
-     tidy_scalarVars = mkVarSet [ lookup_var var
-                                | var <- varSetElems scalarVars
-                                , isGlobalId var || isExportedId var]
+     tidy_parallelVars = mkVarSet [ tidy_var
+                                  | var <- varSetElems parallelVars
+                                  , let tidy_var = lookup_var var
+                                  , isExternalId tidy_var]
  
      lookup_var var = lookupWithDefaultVarEnv var_env var var
+     
+     isExternalId = isExternalName . idName
  \end{code}
  
 +Note [Don't attempt to trim data types]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 +For some time GHC tried to avoid exporting the data constructors
 +of a data type if it wasn't strictly necessary to do so; see Trac #835.
 +But "strictly necessary" accumulated a longer and longer list 
 +of exceptions, and finally I gave up the battle:
 +
 +    commit 9a20e540754fc2af74c2e7392f2786a81d8d5f11
 +    Author: Simon Peyton Jones <simonpj@microsoft.com>
 +    Date:   Thu Dec 6 16:03:16 2012 +0000
 +
 +    Stop attempting to "trim" data types in interface files
 +    
 +    Without -O, we previously tried to make interface files smaller
 +    by not including the data constructors of data types.  But
 +    there are a lot of exceptions, notably when Template Haskell is
 +    involved or, more recently, DataKinds.
 +    
 +    However Trac #7445 shows that even without TemplateHaskell, using
 +    the Data class and invoking Language.Haskell.TH.Quote.dataToExpQ
 +    is enough to require us to expose the data constructors.
 +    
 +    So I've given up on this "optimisation" -- it's probably not
 +    important anyway.  Now I'm simply not attempting to trim off
 +    the data constructors.  The gain in simplicity is worth the
 +    modest cost in interface file growth, which is limited to the
 +    bits reqd to describe those data constructors.
  
  %************************************************************************
  %*                                                                      *
Simple merge
Simple merge
@@@ -53,23 -61,28 +53,27 @@@ import Data.Lis
  Here's the externally-callable interface:
  
  \begin{code}
 -occurAnalysePgm :: Module     -- Used only in debug output
 +occurAnalysePgm :: Module       -- Used only in debug output
-                 -> (Activation -> Bool)
-                 -> [CoreRule] -> [CoreVect]
+                 -> (Activation -> Bool) 
+                 -> [CoreRule] -> [CoreVect] -> VarSet
                  -> CoreProgram -> CoreProgram
- occurAnalysePgm this_mod active_rule imp_rules vects binds
+ occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds
    | isEmptyVarEnv final_usage
    = binds'
 -  | otherwise -- See Note [Glomming]
 +  | otherwise   -- See Note [Glomming]
    = WARN( True, hang (text "Glomming in" <+> ppr this_mod <> colon)
                     2 (ppr final_usage ) )
 -    [Rec (flattenBinds binds')]        
 +    [Rec (flattenBinds binds')]
    where
      (final_usage, binds') = go (initOccEnv active_rule) binds
  
-     initial_uds = addIdOccs emptyDetails
-                             (rulesFreeVars imp_rules `unionVarSet` vectsFreeVars vects)
-     -- The RULES and VECTORISE declarations keep things alive!
+     initial_uds = addIdOccs emptyDetails 
 -                            -- (rulesFreeVars imp_rules `unionVarSet` vectsFreeVars vects)
+                             (rulesFreeVars imp_rules `unionVarSet` 
+                              vectsFreeVars vects `unionVarSet`
+                              vectVars)
+     -- The RULES and VECTORISE declarations keep things alive! (For VECTORISE declarations,
+     -- we only get them *until* the vectoriser runs. Afterwards, these dependencies are
+     -- reflected in 'vectors' — see Note [Vectorisation declarations and occurences].)
  
      -- Note [Preventing loops due to imported functions rules]
      imp_rules_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv
Simple merge
Simple merge
Simple merge
@@@ -29,11 -27,8 +27,9 @@@ import DynFlag
  import Outputable
  import Util                 ( zipLazy )
  import MonadUtils
 +import FamInstEnv           ( toBranchedFamInst )
  
  import Control.Monad
- import Data.Maybe
  
  
  -- |Vectorise a single module.
Simple merge
@@@ -42,14 -42,13 +42,16 @@@ import Litera
  import TysPrim
  import Outputable
  import FastString
+ import DynFlags
+ import Util
+ import MonadUtils
  import Control.Monad
- import Control.Applicative
  import Data.Maybe
  import Data.List
 +import TcRnMonad (goptM)
 +import DynFlags
 +import Util
  
  
  -- Main entry point to vectorise expressions -----------------------------------
@@@ -733,10 -802,10 +806,10 @@@ vectLam inline loop_breaker expr@((fvs
             ; lty   <- mkPDataType ty
             ; return (ve, mkWildCase (Var lc) intPrimTy lty
                             [(DEFAULT, [], le),
 -                            (LitAlt (mkMachInt 0), [], empty)])
 +                            (LitAlt (mkMachInt dflags 0), [], empty)])
             }
        | otherwise = return (ve, le)
- vectLam _ _ _ _ = panic "vectLam"
+ vectLam _ _ _ = panic "Vectorise.Exp.vectLam: not a lambda"
  
  -- Vectorise an algebraic case expression.
  --
@@@ -843,13 -921,12 +925,13 @@@ vectAlgCase tycon _ty_args scrut bndr t
      cmp _             DEFAULT       = GT
      cmp _             _             = panic "vectAlgCase/cmp"
  
-     proc_alt arity sel _ lty ((DataAlt dc, bndrs, body),  vi)
+     proc_alt arity sel _ lty (DataAlt dc, bndrs, body@((fvs_body, _), _))
        = do
 +          dflags <- getDynFlags
            vect_dc <- maybeV dataConErr (lookupDataCon dc)
            let ntag = dataConTagZ vect_dc
 -              tag  = mkDataConTag vect_dc
 +              tag  = mkDataConTag dflags vect_dc
-               fvs  = freeVarsOf body `delVarSetList` bndrs
+               fvs  = fvs_body `delVarSetList` bndrs
  
            sel_tags  <- liftM (`App` sel) (builtin (selTags arity))
            lc        <- builtin liftingContext
@@@ -61,9 -70,9 +70,9 @@@ lookupFamInst tycon ty
    = ASSERT( isFamilyTyCon tycon )
      do { instEnv <- readGEnv global_fam_inst_env
         ; case lookupFamInstEnv instEnv tycon tys of
 -           [(fam_inst, rep_tys)] -> return ( fam_inst, rep_tys)
 +           [match] -> return match
             _other                -> 
               do dflags <- getDynFlags
-                 cantVectorise dflags "VectMonad.lookupFamInst: not found: "
+                 cantVectorise dflags "Vectorise.Monad.InstEnv.lookupFamInst: not found: "
                             (ppr $ mkTyConApp tycon tys)
         }