[commit: ghc] master: Make buildToArrPReprs obey the let/app invariant (d174f49)

[git at git.haskell.org]

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

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

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

commit d174f49cafd14bbb448ca3c16a6743eaae942173
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Aug 4 13:03:09 2014 +0100

    Make buildToArrPReprs obey the let/app invariant
    
    Vectorise.Generic.PAMethods.buildToArrPReprs was building an expression like
       pvoids# (lengthSels2# sels)
    which does not satisfy the let/app invariant.  It should be more like
      case lengthSels2# sels of l -> pvoids# l
    
    This was caught by Core Lint (once it was taught to check for the invariant)


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

d174f49cafd14bbb448ca3c16a6743eaae942173
 compiler/vectorise/Vectorise/Generic/PAMethods.hs | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
index 269119c..0d5d37c 100644
--- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs
+++ b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
@@ -16,7 +16,7 @@ import Vectorise.Generic.Description
 import CoreSyn
 import CoreUtils
 import FamInstEnv
-import MkCore            ( mkWildCase )
+import MkCore            ( mkWildCase, mkCoreLet )
 import TyCon
 import CoAxiom
 import Type
@@ -24,6 +24,7 @@ import OccName
 import Coercion
 import MkId
 import FamInst
+import TysPrim( intPrimTy )
 
 import DynFlags
 import FastString
@@ -404,9 +405,13 @@ buildToArrPReprs vect_tc repr_co _ pdatas_tc r
                 -- and PDatas Void arrays in the product. See Note [Empty PDatas].
                 let xSums        =  App (repr_selsLength_v ss) (Var sels)
 
-                (vars, exprs)    <- mapAndUnzipM (to_con xSums) (repr_cons ss)
+                xSums_var <- newLocalVar (fsLit "xsum") intPrimTy
+
+                (vars, exprs)    <- mapAndUnzipM (to_con xSums_var) (repr_cons ss)
                 return ( sels : concat vars
                        , wrapFamInstBody psums_tc (repr_con_tys ss)
+                         $ mkCoreLet (NonRec xSums_var xSums)
+                                 -- mkCoreLet ensures that the let/app invariant holds
                          $ mkConApp psums_con 
                          $ map Type (repr_con_tys ss) ++ (Var sels : exprs))        
 
@@ -414,7 +419,7 @@ buildToArrPReprs vect_tc repr_co _ pdatas_tc r
      = case ss of
         EmptyProd    
          -> do  pvoids  <- builtin pvoidsVar
-                return ([], App (Var pvoids) xSums )
+                return ([], App (Var pvoids) (Var xSums) )
 
         UnaryProd r
          -> do  pty  <- mkPDatasType (compOrigType r)