I noticed that currently there is not way to define "SPECIALIZE + phase" pragma from TH, only "SPECIALIZE (NO)INLINE + phase". One thing led to another, and I ended up refactoring the Pragma data type. Attached patches

• Allow "SPECIALIZE + phase" pragma
• Replace Maybe (Bool, Int) with something human-readable.
• Add RULES pragma support
• Add "SPECIALIZE instance" pragma support
• Modify pretty printing of pragmas to follow GHC ppr indentation more closely.

Here is a little demo:

HsToTh.hs:

{-# LANGUAGE TemplateHaskell #-}

module HsToTh (decls, hsToTh) where

import Language.Haskell.TH

decls = [d|
    f1 x = 1; f2 x = 2; f3 x = 3
    {-# INLINE f1 #-} 
    {-# INLINE [2] f2 #-} 
    {-# INLINE CONLIKE [~2] f3 #-} 
    g1 x = 1; g2 x = 2; g3 x = 3
    {-# SPECIALISE g1 :: Int -> Int #-}
    {-# SPECIALISE [2] g2 :: Int -> Int #-}
    {-# SPECIALISE INLINE [~2] g3 :: Int -> Int #-}
    data T a = T a
    instance Eq a => Eq (T a) where
      {-# SPECIALISE instance Eq (T Int) #-}
      (T x) == (T y) = x == y
    {-# RULES
          "rule1" fromIntegral = id :: a -> a ;
          "rule2" [1] forall (x :: a) . fromIntegral x = x ;
          "rule3" [~1] forall (x :: a) . fromIntegral x = x
      #-}
  |]

hsToTh = do
  decls' <- runQ decls
  mapM (print . ppr) decls'

ThToHs.hs:

{-# LANGUAGE TemplateHaskell #-}

import HsToTh

$(decls)

main = hsToTh

TH -> Hs (actually Hs -> TH -> Hs):

$ ./Dev/ghc/inplace/bin/ghc-stage2 -dcore-lint -ddump-splices -fforce-recomp HsToTh.hs ThToHs.hs
[1 of 2] Compiling HsToTh           ( HsToTh.hs, HsToTh.o )
[2 of 2] Compiling Main             ( ThToHs.hs, ThToHs.o )
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package pretty-1.1.1.0 ... linking ... done.
Loading package array-0.3.0.3 ... linking ... done.
Loading package deepseq-1.2.0.1 ... linking ... done.
Loading package containers-0.5.0.0 ... linking ... done.
Loading package template-haskell ... linking ... done.
ThToHs.hs:1:1: Splicing declarations
    decls
  ======>
    ThToHs.hs:5:3-7
    f1_a2rr x_a2ru = 1
    f2_a2rq x_a2rv = 2
    f3_a2rp x_a2rw = 3
    {-# INLINE f1_a2rr #-}
    {-# INLINE[2] f2_a2rq #-}
    {-# INLINE[~2] CONLIKE f3_a2rp #-}
    g1_a2ro x_a2rx = 1
    g2_a2rn x_a2ry = 2
    g3_a2rm x_a2rz = 3
    {-# SPECIALIZE g1_a2ro :: Int -> Int #-}
    {-# SPECIALIZE [2] g2_a2rn :: Int -> Int #-}
    {-# SPECIALIZE INLINE[~2] g3_a2rm :: Int -> Int #-}
    data T_a2rs a_a2rA = T_a2rt a_a2rA
    instance Eq a_a2rB => Eq (T_a2rs a_a2rB) where
      {-# SPECIALIZE instance Eq (T_a2rs Int) #-}
      == (T_a2rt x_a2rC) (T_a2rt y_a2rD) = (x_a2rC == y_a2rD)
    {-# RULES "rule1" [ALWAYS]
        fromIntegral
        = id :: forall a_a2rE. a_a2rE -> a_a2rE #-}
    {-# RULES "rule2" [1] forall x::a. fromIntegral x = x #-}
    {-# RULES "rule3" [~1] forall x::a. fromIntegral x = x #-}
Linking ThToHs ...

Hs -> TH:

$ ./ThToHs 
f1_0 x_1 = 1
f2_0 x_1 = 2
f3_0 x_1 = 3
{-# INLINE f1_0 #-}
{-# INLINE [2] f2_0 #-}
{-# INLINE CONLIKE [~2] f3_0 #-}
g1_0 x_1 = 1
g2_0 x_1 = 2
g3_0 x_1 = 3
{-# SPECIALISE g1_0 :: GHC.Types.Int -> GHC.Types.Int #-}
{-# SPECIALISE [2] g2_0 :: GHC.Types.Int -> GHC.Types.Int #-}
{-# SPECIALISE INLINE [~2] g3_0 ::
                             GHC.Types.Int -> GHC.Types.Int #-}
data T_0 a_1 = T_2 a_1
instance GHC.Classes.Eq a_0 => GHC.Classes.Eq (T_1 a_0)
    where GHC.Classes.== (T_2 x_3) (T_2 y_4) = x_3 GHC.Classes.== y_4
          {-# SPECIALISE instance GHC.Classes.Eq (T_1 GHC.Types.Int) #-}
{-# RULES "rule1"
    GHC.Real.fromIntegral
    = GHC.Base.id :: forall a_0 . a_0 -> a_0 #-}
{-# RULES "rule2" [1]
    forall (x_1627391595 :: a_1627391596) . GHC.Real.fromIntegral x_1627391595
    = x_1627391595 #-}
{-# RULES "rule3" [~1]
    forall (x_1627391593 :: a_1627391594) . GHC.Real.fromIntegral x_1627391593
    = x_1627391593 #-}

Please review.