Skip to content

Instantly share code, notes, and snippets.

@monadplus
Last active July 1, 2022 11:21
Show Gist options
  • Save monadplus/15c64315520afbcc5b55b04e1837a13c to your computer and use it in GitHub Desktop.
Save monadplus/15c64315520afbcc5b55b04e1837a13c to your computer and use it in GitHub Desktop.
Hasell: coerce

Will they produce the same CORE? With -O2 they do.

newtype A a = MkA { unA :: a }
  deriving newtype Show

data B = B [A String]
  deriving stock Show

foo :: [String] -> B
foo = B . fmap MkA

foo' :: [String] -> B
foo' = B . fmap coerce

foo'' :: [String] -> B
foo'' = B . coerce

main :: IO ()
main = do
  let ss = ["hello", "world"]
  print $ foo ss
  print $ foo' ss
  print $ foo'' ss
-- RHS size: {terms: 3, types: 2, coercions: 4, joins: 0/0}
foo' :: [String] -> B
[GblId,
 Arity=1,
 Str=<L>,
 Cpr=1,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
         Tmpl= \ (x_a1h2 [Occ=Once1] :: [String]) ->
                 Main.B
                   (x_a1h2
                    `cast` (([Sym (Main.N:A[0] <String>_R)])_R
                            :: [String] ~R# [A String]))}]
foo'
  = \ (x_a1h2 :: [String]) ->
      Main.B
        (x_a1h2
         `cast` (([Sym (Main.N:A[0] <String>_R)])_R
                 :: [String] ~R# [A String]))

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
foo :: [String] -> B
[GblId,
 Arity=1,
 Str=<L>,
 Cpr=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
foo = foo'

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
foo'' :: [String] -> B
[GblId,
 Arity=1,
 Str=<L>,
 Cpr=1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
foo'' = foo'

With -O0 they produce a totally different output:

-- RHS size: {terms: 8, types: 14, coercions: 6, joins: 0/0}
foo' :: [String] -> B
[GblId]
foo'
  = break<2>()
    . @[A String]
      @B
      @[String]
      (\ (ds_d22P :: [A String]) -> Main.B ds_d22P)
      (break<1>()
       fmap
         @[]
         GHC.Base.$fFunctor[]
         @String
         @(A String)
         ((\ (v_B2 :: String) -> v_B2)
          `cast` (<String>_R %<'Many>_N ->_R Sym (Main.N:A[0] <String>_R)
                  :: (String -> String) ~R# (String -> A String))))

-- RHS size: {terms: 8, types: 14, coercions: 6, joins: 0/0}
foo :: [String] -> B
[GblId]
foo
  = break<4>()
    . @[A String]
      @B
      @[String]
      (\ (ds_d22Q :: [A String]) -> Main.B ds_d22Q)
      (break<3>()
       fmap
         @[]
         GHC.Base.$fFunctor[]
         @String
         @(A String)
         ((\ (ds_d22R :: String) -> ds_d22R)
          `cast` (<String>_R %<'Many>_N ->_R Sym (Main.N:A[0] <String>_R)
                  :: (String -> String) ~R# (String -> A String))))

-- RHS size: {terms: 6, types: 11, coercions: 8, joins: 0/0}
foo'' :: [String] -> B
[GblId]
foo''
  = break<0>()
    . @[A String]
      @B
      @[String]
      (\ (ds_d22O :: [A String]) -> Main.B ds_d22O)
      ((\ (v_B2 :: [String]) -> v_B2)
       `cast` (<[String]>_R
               %<'Many>_N ->_R ([Sym (Main.N:A[0] <String>_R)])_R
               :: ([String] -> [String]) ~R# ([String] -> [A String])))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment