TH: Pragmas refactoring (also adds RULES and 'SPECIALIZE instance' support) [patch]

[mikhail.vorozhtsov]

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.

[mikhail.vorozhtsov]

Patch for the template-haskell library

[mikhail.vorozhtsov]

Patch for the GHC

[simonpj]

OK I've committed these to HEAD.

Paolo can you merge to 7.6 please? Relevant patches are these.

Thanks for doing the work, Mikhail.

GHC

commit 1993ee4ba8d30d6774c2330477a1eecf865dfa1f
Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
Date:   Tue Jul 10 21:37:42 2012 +0700

    TH: Pragmas refactoring.
    
    Also adds RULES and 'SPECIALIZE instance' support.

template-haskell

commit a97ca3a18b359c6a4331c0f57dcfaba3b0e58225
Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
Date:   Tue Jul 10 21:01:05 2012 +0700

    Pragmas refactoring. Also adds RULES and 'SPECIALIZE instance' support.

dph

commit 77a55115166ead37fc87b811f80cd394e053368f
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date:   Wed Aug 15 14:22:42 2012 +0100

    Adapt to new TH pragma data type

testsuite

commit 15b8a3e962e1b21a57a49f56ddd17eae2ac5a905
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date:   Wed Aug 15 14:22:10 2012 +0100

    Adapt to new TH pragma data types

[pcapriotti]

Merged as 6d0e2f288a34f12f5e3228415351d5bb4280c814 and db0b4de55926b0bc98717c92ba543bcf9b89d024.

[simonpj]

Actually we need this too

commit 5e54d55738d2144ab99e7b483bc4d237c1657251
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date:   Fri Oct 19 00:48:41 2012 +0100

    Fix conversion of HsRule to TH syntax
    
    We weren't doing the binders right, and were creating NameLs
    rather than NameUs for the binders of the Rule.  That gave
    very funny output for T7064.

 compiler/deSugar/DsMeta.hs |  132 ++++++++++++++++++++++----------------------
 1 files changed, 67 insertions(+), 65 deletions(-)