X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=19ac62ff8a1b93753be558085d8dbb21d6c67c8b;hp=a0a229f6c66807e202d2a393d165aea16fd37373;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=fdf8656855d26105ff36bdd24d41827b05037b91 diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index a0a229f..19ac62f 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -589,12 +589,16 @@ exprIsCheap' good_app other_expr -- Applications and variables go _ _ = False -------------- - go_pap args = all exprIsTrivial args - -- For constructor applications and primops, check that all - -- the args are trivial. We don't want to treat as cheap, say, - -- (1:2:3:4:5:[]) - -- We'll put up with one constructor application, but not dozens - + go_pap args = all (exprIsCheap' good_app) args + -- Used to be "all exprIsTrivial args" due to concerns about + -- duplicating nested constructor applications, but see #4978. + -- The principle here is that + -- let x = a +# b in c *# x + -- should behave equivalently to + -- c *# (a +# b) + -- Since lets with cheap RHSs are accepted, + -- so should paps with cheap arguments + -------------- go_primop op args = primOpIsCheap op && all (exprIsCheap' good_app) args -- In principle we should worry about primops