[commit: ghc] master: removed superfluous flag for vectScalarFun (61e9a6c)

Gabriele Keller keller at galois.com
Wed Apr 25 12:16:49 CEST 2012


Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/61e9a6cc3536a28ae3b9d3507d2bda58993c2fe5

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

commit 61e9a6cc3536a28ae3b9d3507d2bda58993c2fe5
Author: Gabriele Keller <keller at cse.unsw.edu.au>
Date:   Wed Apr 25 14:37:26 2012 +1000

    removed superfluous flag for vectScalarFun

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

 compiler/vectorise/Vectorise.hs     |    2 +-
 compiler/vectorise/Vectorise/Exp.hs |   35 ++++++++++++-----------------------
 2 files changed, 13 insertions(+), 24 deletions(-)

diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 88fc947..8f6e321 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -361,7 +361,7 @@ vectTopRhs recFs var expr
     rhs _globalScalar _isDFun (Just (_, expr'))               -- Case (1)
       = return (inlineMe, False, expr')
     rhs True          False   Nothing                         -- Case (2)
-      = do { expr' <- vectScalarFun True recFs expr
+      = do { expr' <- vectScalarFun recFs expr
            ; return (inlineMe, True, vectorised expr')
            }
     rhs True          True    Nothing                         -- Case (3)
diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
index 36fe910..0764c3b 100644
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ b/compiler/vectorise/Vectorise/Exp.hs
@@ -689,14 +689,13 @@ vectDictExpr (Coercion coe)
 -- instead they become dictionaries of vectorised methods).  We treat them differently, though see
 -- "Note [Scalar dfuns]" in 'Vectorise'.
 --
-vectScalarFun :: Bool       -- ^ Was the function marked as scalar by the user?
-              -> [Var]      -- ^ Functions names in same recursive binding group
+vectScalarFun :: [Var]      -- ^ Functions names in same recursive binding group
               -> CoreExpr   -- ^ Expression to be vectorised
               -> VM VExpr
-vectScalarFun forceScalar recFns expr 
- = vectScalarFunVT forceScalar recFns expr (VITNode VISimple [])
-
-
+vectScalarFun recFns expr 
+ -- this is an external call to vectScalarFun, so we pass a dummy vt tree. The only
+ -- relevant bit is that the node info is *not* VIEncaps
+ = vectScalarFunVT True recFns expr (VITNode VISimple []) 
 
 
 vectScalarFunVT :: Bool       -- ^ Was the function marked as scalar by the user?
@@ -715,34 +714,24 @@ vectScalarFunVT forceScalar recFns expr (VITNode vi _)
                    "\n\tresult  scalar?    : " ++ (show $is_scalar_ty scalarTyCons res_ty) ++
                    "\n\tscalar body?       : " ++ (show $is_scalar scalarVars (is_scalar_ty scalarTyCons) expr) ++
                    "\n\tuses vars?         : " ++ (show $uses scalarVars expr) ++
-                   "\n\t is encaps?        : " ++ (show vi)
+                   "\n\t is encaps? (same as & of all prev cond): " ++ (show vi)
                   )
            (ppr expr)
        ; onlyIfV (ptext (sLit "not a scalar function"))
                  (forceScalar                              -- user asserts the functions is scalar
                   ||
-                  (vi == VIEncaps)                         -- should only be true if all the foll. cond are hold
-                  ||
+                  (vi == VIEncaps))                         -- should only be true if all the foll. cond are hold
+
+{-                  ||
                   all (is_scalar_ty scalarTyCons) arg_tys  -- check whether the function is scalar
                    && is_scalar_ty scalarTyCons res_ty
                    && is_scalar scalarVars (is_scalar_ty scalarTyCons) expr
                    && uses scalarVars expr)
+ -}
          $ do { traceVt  "vectScalarFun - is scalar"  (ppr expr) 
               ;  mkScalarFun arg_tys res_ty expr
               }
        }      
-{-
-      ; onlyIfV (ptext (sLit "not a scalar function"))
-                (forceScalar                                 -- user asserts the functions is scalar
-                 ||
-                 all is_primitive_ty arg_tys                 -- check whether the function is scalar
-                  && is_primitive_ty res_ty
-                  && is_scalar scalarVars (is_scalar_ty scalarTyCons) expr
-                  && uses scalarVars expr
-                  && length arg_tys <= mAX_DPH_SCALAR_ARGS)
-        $ mkScalarFun arg_tys res_ty expr
-      }
-      -}
   where
     {-
     -- !!!FIXME: We would like to allow scalar functions with arguments and results that can be
@@ -912,7 +901,7 @@ vectScalarDFun var recFns
              dict           = Var var `mkTyApps` (mkTyVarTys tvs) `mkVarApps` thetaVars
              scsOps         = map (\selId -> varToCoreExpr selId `mkTyApps` tys `mkApps` [dict])
                                   selIds
-       ; vScsOps <- mapM (\e -> vectorised <$> vectScalarFun True recFns e) scsOps
+       ; vScsOps <- mapM (\e -> vectorised <$> vectScalarFun recFns e) scsOps
 
            -- vectorised applications of the class-dictionary data constructor
        ; Just vDataCon <- lookupDataCon dataCon
@@ -1181,8 +1170,8 @@ vectAlgCase tycon _ty_args scrut bndr ty alts (VITNode _ (scrutVit : altVits))
 vectAlgCase tycon _ty_args _scrut _bndr _ty _alts (VITNode _ [])
   = pprPanic "vectAlgCase (mismatched node information)" (ppr tycon)
 
----- Sanity check  of the 
 {-
+---- Sanity check  of the tree, for debugging only
 checkTree :: VITree -> CoreExpr -> Bool
 checkTree  (VITNode _ []) (Type _ty) 
   = True





More information about the Cvs-ghc mailing list