diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-04 13:03:09 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-07 09:55:16 +0100 |
commit | d174f49cafd14bbb448ca3c16a6743eaae942173 (patch) | |
tree | 1be172e452ecaa4cf6304ef96514df52d8cb8eeb | |
parent | 1fc60ea1f1fd89b90c2992d060aecb5b5a65f8c0 (diff) | |
download | haskell-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)
-rw-r--r-- | compiler/vectorise/Vectorise/Generic/PAMethods.hs | 11 |
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) |