
That's because of the CSE (common subexpression elimination) pass. Here's an
example:
module Lib where
foo :: a -> a
foo x = x
bar :: a -> a
bar x = x
Build with -O -ddump-stg and you'll see something like:
Lib.foo :: forall a. a -> a
[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] =
[] \r [x_s1bB] x_s1bB;
Lib.bar :: forall a. a -> a
[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] =
[] \r [eta_B1] Lib.foo eta_B1;
Without -O or with -fno-cse this does not happen.
This is quite unexpected, but maybe not harmful.
Ömer
Shao, Cheng
Hi devs,
I just found that the Cmm code of `GHC.Base.id` refers to `breakpoint` in the same module, however, in the Haskell source of `GHC.Base`, the definition of `id` and `breakpoint` are totally unrelated:
``` id :: a -> a id x = x
breakpoint :: a -> a breakpoint r = r ```
And here's the pretty-printed Cmm code:
``` base_GHCziBase_id_entry() // [R2] { [] } {offset chwa: // global R2 = R2; call base_GHCziBase_breakpoint_entry(R2) args: 8, res: 0, upd: 8; } base_GHCziBase_breakpoint_entry() // [R2] { [] } {offset chvW: // global R1 = R2; call stg_ap_0_fast(R1) args: 8, res: 0, upd: 8; } ```
This looks suspicious. I'm curious if this is intended behavior of ghc.
Regards, Shao Cheng _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs