projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2005-02-23 09:13:49 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
coreSyn
/
CorePrep.lhs
diff --git
a/ghc/compiler/coreSyn/CorePrep.lhs
b/ghc/compiler/coreSyn/CorePrep.lhs
index
12aca16
..
d7d2a99
100644
(file)
--- a/
ghc/compiler/coreSyn/CorePrep.lhs
+++ b/
ghc/compiler/coreSyn/CorePrep.lhs
@@
-560,16
+560,16
@@
maybeSaturate fn expr n_args floats ty
-- Ensure that the argument of DataToTagOp is evaluated
eval_data2tag_arg :: CoreExpr -> UniqSM (Floats, CoreExpr)
-- Ensure that the argument of DataToTagOp is evaluated
eval_data2tag_arg :: CoreExpr -> UniqSM (Floats, CoreExpr)
- eval_data2tag_arg app@(fun `App` Var arg_id)
- | isEvaldUnfolding (idUnfolding arg_id) -- Includes nullary constructors
+ eval_data2tag_arg app@(fun `App` arg)
+ | exprIsValue arg -- Includes nullary constructors
= returnUs (emptyFloats, app) -- The arg is evaluated
| otherwise -- Arg not evaluated, so evaluate it
= returnUs (emptyFloats, app) -- The arg is evaluated
| otherwise -- Arg not evaluated, so evaluate it
- = newVar (idType arg_id) `thenUs` \ arg_id1 ->
+ = newVar (exprType arg) `thenUs` \ arg_id ->
let
let
- arg_id2 = setIdUnfolding arg_id1 evaldUnfolding
+ arg_id1 = setIdUnfolding arg_id evaldUnfolding
in
in
- returnUs (unitFloat (FloatCase arg_id2 (Var arg_id) False ),
- fun `App` Var arg_id2)
+ returnUs (unitFloat (FloatCase arg_id1 arg False ),
+ fun `App` Var arg_id1)
eval_data2tag_arg (Note note app) -- Scc notes can appear
= eval_data2tag_arg app `thenUs` \ (floats, app') ->
eval_data2tag_arg (Note note app) -- Scc notes can appear
= eval_data2tag_arg app `thenUs` \ (floats, app') ->