summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2014-08-04 13:03:09 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2014-08-07 09:55:16 +0100
commitd174f49cafd14bbb448ca3c16a6743eaae942173 (patch)
tree1be172e452ecaa4cf6304ef96514df52d8cb8eeb /compiler
parent1fc60ea1f1fd89b90c2992d060aecb5b5a65f8c0 (diff)
downloadhaskell-d174f49cafd14bbb448ca3c16a6743eaae942173.tar.gz
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)
Diffstat (limited to 'compiler')
-rw-r--r--compiler/vectorise/Vectorise/Generic/PAMethods.hs11
1 files changed, 8 insertions, 3 deletions
diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
index 269119c6dd..0d5d37c7d7 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)