Skip to content

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
    • Help
    • Support
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project
    • Project
    • Details
    • Activity
    • Releases
    • Cycle Analytics
    • Insights
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Charts
    • Locked Files
  • Issues 3,607
    • Issues 3,607
    • List
    • Boards
    • Labels
    • Milestones
  • Merge Requests 199
    • Merge Requests 199
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
    • Charts
  • Security & Compliance
    • Security & Compliance
    • Dependency List
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Collapse sidebar
  • Activity
  • Graph
  • Charts
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #7064

Closed
Open
Opened Jul 10, 2012 by mikhail.vorozhtsov@trac-mikhail.vorozhtsov
  • Report abuse
  • New issue
Report abuse New issue

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

Related issues

  • Discussion
  • Designs
Assignee
Assign to
7.6.1
Milestone
7.6.1
Assign milestone
Time tracking
None
Due date
None
4
Labels
bug P::normal TemplateHaskell Trac import
Assign labels
  • View project labels
Reference: ghc/ghc#7064