#7064: TH: Pragmas refactoring (also adds RULES and 'SPECIALIZE instance'
support)
[patch]
--------------------------------+-------------------------------------------
Reporter: mikhail.vorozhtsov | Owner:
Type: bug | Status: new
Priority: normal | Component: Template Haskell
Version: 7.5 | Keywords:
Os: Unknown/Multiple | Architecture: Unknown/Multiple
Failure: None/Unknown | Testcase:
Blockedby: | Blocking:
Related: |
--------------------------------+-------------------------------------------
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.
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/7064>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
