Commit c190b73f authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu

Merge some instances from th-orphans.

parent 02b4845e
......@@ -211,6 +211,9 @@ pprBody eq body = case body of
| otherwise = arrow
------------------------------
instance Ppr Lit where
ppr = pprLit noPrec
pprLit :: Precedence -> Lit -> Doc
pprLit i (IntPrimL x) = parensIf (i > noPrec && x < 0)
(integer x <> char '#')
......@@ -576,3 +579,14 @@ hashParens d = text "(# " <> d <> text " #)"
quoteParens :: Doc -> Doc
quoteParens d = text "'(" <> d <> text ")"
-----------------------------
instance Ppr Loc where
ppr (Loc { loc_module = md
, loc_package = pkg
, loc_start = (start_ln, start_col)
, loc_end = (end_ln, end_col) })
= hcat [ text pkg, colon, text md, colon
, parens $ int start_ln <> comma <> int start_col
, text "-"
, parens $ int end_ln <> comma <> int end_col ]
{-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents,
RoleAnnotations, DeriveGeneric, TypeSynonymInstances,
FlexibleInstances #-}
RoleAnnotations, DeriveGeneric, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
......@@ -27,7 +26,9 @@ import System.IO.Unsafe ( unsafePerformIO )
import Control.Monad (liftM)
import System.IO ( hPutStrLn, stderr )
import Data.Char ( isAlpha, isAlphaNum, isUpper )
import Data.Word ( Word8 )
import Data.Int
import Data.Word
import Data.Ratio
import GHC.Generics ( Generic )
-----------------------------------------------------
......@@ -36,7 +37,7 @@ import GHC.Generics ( Generic )
--
-----------------------------------------------------
class (Monad m, Applicative m) => Quasi m where
class Monad m => Quasi m where
qNewName :: String -> m Name
-- ^ Fresh names
......@@ -457,8 +458,41 @@ instance Lift Integer where
instance Lift Int where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Rational where
lift x = return (LitE (RationalL x))
instance Lift Int8 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Int16 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Int32 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Int64 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word8 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word16 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word32 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word64 where
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Integral a => Lift (Ratio a) where
lift x = return (LitE (RationalL (toRational x)))
instance Lift Float where
lift x = return (LitE (RationalL (toRational x)))
instance Lift Double where
lift x = return (LitE (RationalL (toRational x)))
instance Lift Char where
lift x = return (LitE (CharL x))
......
-- test Lifting instances
{-# LANGUAGE TemplateHaskell #-}
module TH_Lift where
import Language.Haskell.TH.Syntax
import Data.Ratio
import Data.Word
import Data.Int
a :: Integer
a = $( (\x -> [| x |]) (5 :: Integer) )
b :: Int
b = $( (\x -> [| x |]) (5 :: Int) )
b1 :: Int8
b1 = $( (\x -> [| x |]) (5 :: Int8) )
b2 :: Int16
b2 = $( (\x -> [| x |]) (5 :: Int16) )
b3 :: Int32
b3 = $( (\x -> [| x |]) (5 :: Int32) )
b4 :: Int64
b4 = $( (\x -> [| x |]) (5 :: Int64) )
c :: Word
c = $( (\x -> [| x |]) (5 :: Word) )
d :: Word8
d = $( (\x -> [| x |]) (5 :: Word8) )
e :: Word16
e = $( (\x -> [| x |]) (5 :: Word16) )
f :: Word32
f = $( (\x -> [| x |]) (5 :: Word32) )
g :: Word64
g = $( (\x -> [| x |]) (5 :: Word64) )
h :: Rational
h = $( (\x -> [| x |]) (5 % 3 :: Rational) )
h1 :: Float
h1 = $( (\x -> [| x |]) (pi :: Float) )
h2 :: Double
h2 = $( (\x -> [| x |]) (pi :: Double) )
i :: Char
i = $( (\x -> [| x |]) 'x' )
j :: Bool
j = $( (\x -> [| x |]) True )
k :: Maybe Char
k = $( (\x -> [| x |]) (Just 'x') )
l :: Either Char Bool
l = $( (\x -> [| x |]) (Right False :: Either Char Bool) )
m :: [Char]
m = $( (\x -> [| x |]) "hi!")
n :: ()
n = $( (\x -> [| x |]) () )
o :: (Bool, Char, Int)
o = $( (\x -> [| x |]) (True, 'x', 4 :: Int) )
......@@ -354,3 +354,4 @@ test('T1476', normal, compile, ['-v0'])
test('T1476b', normal, compile_fail, ['-v0'])
test('T9824', normal, compile, ['-v0'])
test('T8031', normal, compile, ['-v0'])
test('TH_Lift', normal, compile, ['-v0'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment