diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2016-10-21 19:07:51 -0400 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2016-10-21 20:07:26 -0400 |
| commit | 201332eda995ffe5faee07849e629eea09ec84d4 (patch) | |
| tree | 55c093a0ca53125c243eb682a42498cd8f08d3a1 /compiler/coreSyn | |
| parent | a875ab3b4c3bce7e52ffa270f4c82e79f62b3fb8 (diff) | |
| download | haskell-wip/T12618.tar.gz | |
Cache the analysis of the data con typewip/T12618
for faster compression/decompression.
Diffstat (limited to 'compiler/coreSyn')
| -rw-r--r-- | compiler/coreSyn/CoreFVs.hs | 4 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreSyn.hs | 2 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 2 |
3 files changed, 4 insertions, 4 deletions
diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index 12544b89d2..5f1fad2f2e 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -74,7 +74,7 @@ import Type import TyCoRep import TyCon import CompressArgs -import DataCon ( dataConRepType, dataConWorkId ) +import DataCon ( dataConRepType, dataConCompressScheme, dataConWorkId ) import CoAxiom import FamInstEnv import TysPrim( funTyConName ) @@ -752,7 +752,7 @@ freeVars = go , AnnConApp dc cargs' ) where cargs' = map go cargs - args = uncompressArgs exprTypeFV (go . Type) dc_ty cargs' + args = uncompressArgs exprTypeFV (go . Type) (dataConCompressScheme dc) cargs' dc_ty = dataConRepType dc res_ty = foldl applyTypeToArg dc_ty (map deAnnotate args) -- Why does this not work? Isn't piResultTys just iterated application diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 54a62ef984..b47b21c5a4 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -1501,7 +1501,7 @@ mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars mkConApp dc args = ASSERT2 ( dataConRepFullArity dc == length args, text "mkConApp: artiy mismatch" $$ ppr dc ) - ConApp dc (compressArgs (dataConRepType dc) args) + ConApp dc (compressArgs (dataConCompressScheme dc) args) mkTyApps f args = foldl (\ e a -> App e (typeOrCoercion a)) f args where diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index e71055b26d..89499e3aad 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -212,7 +212,7 @@ applyTypeToArgs e op_ty args -} collectConArgs :: CoreExpr -> [CoreArg] -collectConArgs (ConApp dc cargs) = uncompressArgs exprTypeOrKind Type (dataConRepType dc) cargs +collectConArgs (ConApp dc cargs) = uncompressArgs exprTypeOrKind Type (dataConCompressScheme dc) cargs collectConArgs _ = panic "conAppArgs" |