TH weird behavior re: https://mail.haskell.org/pipermail/haskell-cafe/2021-April/133921.html

0-TH weird behavior(shell commands to reproduce)

$ ghc-9.0.1 -fno-code -ddump-to-file -dsuppress-module-prefixes -dsuppress-type-applications -ddump-ds -ddump-splices Main.hs
[1 of 2] Compiling THPatTest        ( THPatTest.hs, /tmp/ghc31722_0/ghc_4.o, /tmp/ghc31722_0/ghc_4.dyn_o )
[2 of 2] Compiling Main             ( Main.hs, /tmp/ghc31722_0/ghc_2.o, /tmp/ghc31722_0/ghc_2.dyn_o )
$ runghc Main.hs
(2,2,2)
(1,2,1)

Main.hs

{-# LANGUAGE TemplateHaskell #-}
module Main where

import THPatTest

main :: IO ()
main =
  do print (foo 1 2, bar 1 2, baz)
     print ($foo' 1 2, $bar' 1 2, $baz')

THPatTest.dump-ds

==================== Desugar (after optimization) ====================
2021-04-27 15:47:57.467432769 UTC

Result size of Desugar (after optimization)
  = {terms: 128, types: 91, coercions: 0, joins: 0/0}

-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
foo :: Int -> Int -> Int
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
foo = \ _ [Occ=Dead] (x_a268 :: Int) -> x_a268

-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
bar :: Int -> Int -> Int
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
bar = \ _ [Occ=Dead] (x_a26q :: Int) -> x_a26q

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
baz :: Int
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
baz = I# 2#

-- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0}
$trModule :: Module
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 90 10}]
$trModule = Module (TrNameS "main"#) (TrNameS "THPatTest"#)

-- RHS size: {terms: 48, types: 32, coercions: 0, joins: 0/0}
baz' :: ExpQ
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
         WorkFree=False, Expandable=False, Guidance=NEVER}]
baz'
  = >>=
      ($p1Quote $fQuoteQ)
      (newName $fQuoteQ (unpackCString# "x"#))
      (\ (x_a26P :: Name) ->
         letE
           $fQuoteQ
           (: (valD
                 $fQuoteQ
                 (varP $fQuoteQ x_a26P)
                 (normalB $fQuoteQ (litE $fQuoteQ (integerL 1)))
                 [])
              (: (valD
                    $fQuoteQ
                    (>>=
                       ($p1Quote $fQuoteQ)
                       (newName $fQuoteQ (unpackCString# "x"#))
                       (\ (x_a26R :: Name) -> varP $fQuoteQ x_a26R))
                    (normalB $fQuoteQ (litE $fQuoteQ (integerL 2)))
                    [])
                 []))
           (varE $fQuoteQ x_a26P))

-- RHS size: {terms: 30, types: 22, coercions: 0, joins: 0/0}
bar' :: ExpQ
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 430 0}]
bar'
  = >>=
      ($p1Quote $fQuoteQ)
      (newName $fQuoteQ (unpackCString# "x"#))
      (\ (x_a26O :: Name) ->
         lamE
           $fQuoteQ
           (: (>>=
                 ($p1Quote $fQuoteQ)
                 (newName $fQuoteQ (unpackCString# "x"#))
                 (\ (x_a26N :: Name) -> varP $fQuoteQ x_a26N))
              (: (varP $fQuoteQ x_a26O) []))
           (varE $fQuoteQ x_a26O))

-- RHS size: {terms: 30, types: 22, coercions: 0, joins: 0/0}
foo' :: ExpQ
[LclIdX,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 430 0}]
foo'
  = >>=
      ($p1Quote $fQuoteQ)
      (newName $fQuoteQ (unpackCString# "x"#))
      (\ (x_a26J :: Name) ->
         lamE
           $fQuoteQ
           (: (varP $fQuoteQ x_a26J)
              (: (>>=
                    ($p1Quote $fQuoteQ)
                    (newName $fQuoteQ (unpackCString# "x"#))
                    (\ (x_a26L :: Name) -> varP $fQuoteQ x_a26L))
                 []))
           (varE $fQuoteQ x_a26J))

THPatTest.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExtendedDefaultRules #-}
module THPatTest where

import Language.Haskell.TH

foo, bar :: Int -> Int -> Int
foo x $([p| x |] :: PatQ) = x
bar $([p| x |] :: PatQ) x = x

baz :: Int
baz = let { x = 1; $([p| x |] :: PatQ) = 2 } in x

foo', bar', baz' :: ExpQ
foo' = [| \x $([p| x |]) -> x |]
bar' = [| \ $([p| x |]) x -> x |]
baz' = [| let { x = 1; $([p| x |]) = 2 } in x |]