TH: Pragmas refactoring (also adds RULES and 'SPECIALIZE instance' support) [patch]
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.
Trac metadata
Trac field | Value |
---|---|
Version | 7.5 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Template Haskell |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |