LambdaSharing.hs

{-# OPTIONS_GHC
    -ddump-simpl
    -dsuppress-idinfo
    -dsuppress-coercions
    -dsuppress-type-applications
    -dsuppress-uniques
    -dsuppress-module-prefixes
#-}

import           Debug.Trace

main = print $ x1 + x2 + x3 + x4

f1, f2, f3, f4 :: Int -> Int
f1   = \x -> trace "f1" 0 + x
f2 x = trace "f2" 0 + x
f3   = (trace "f3" 0 +)
f4   = (+) (trace "f4" 0)

apply :: (Int -> Int) -> (Int -> Int) -> Int
apply f g = f 42 + g 42

x1 = let f = f1
     in apply f f

x2 = let f = f2
     in apply f f

x3 = let f = f3
     in apply f f

x4 = let f = f4
     in apply f f

-- Core output with -O0:

{- ...
--RHS size: {terms: 10, types: 5, coercions: 0, joins: 0/0}
apply :: (Int -> Int) -> (Int -> Int) -> Int
apply
  = \ (f :: Int -> Int) (g :: Int -> Int) ->
      + $fNumInt (f (I# 42#)) (g (I# 42#))

-- RHS size: {terms: 67, types: 28, coercions: 0, joins: 0/4}
main :: IO ()
main
  = $ (print $fShowInt)
      (+ $fNumInt
         (+ $fNumInt
            (+ $fNumInt
               (let {
                  f :: Int -> Int
                  f = \ (x :: Int) ->
                        + $fNumInt (trace (unpackCString# "f1"#) (I# 0#)) x } in
                + $fNumInt (f (I# 42#)) (f (I# 42#)))
               (let {
                  f :: Int -> Int
                  f = \ (x :: Int) ->
                        + $fNumInt (trace (unpackCString# "f2"#) (I# 0#)) x } in
                + $fNumInt (f (I# 42#)) (f (I# 42#))))
            (let {
               f :: Int -> Int
               f = + $fNumInt (trace (unpackCString# "f3"#) (I# 0#)) } in
             apply f f))
         (let {
            f :: Int -> Int
            f = + $fNumInt (trace (unpackCString# "f4"#) (I# 0#)) } in
          apply f f))
-}

-- Output:

{-
f1
f1
f2
f2
f3
f4
336
-}