Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
c190b73f
Commit
c190b73f
authored
Dec 16, 2014
by
eir@cis.upenn.edu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Merge some instances from th-orphans.
parent
02b4845e
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
130 additions
and
6 deletions
+130
-6
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+14
-0
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+40
-6
testsuite/tests/th/TH_Lift.hs
testsuite/tests/th/TH_Lift.hs
+75
-0
testsuite/tests/th/all.T
testsuite/tests/th/all.T
+1
-0
No files found.
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
View file @
c190b73f
...
...
@@ -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
]
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
View file @
c190b73f
{-# 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
))
...
...
testsuite/tests/th/TH_Lift.hs
0 → 100644
View file @
c190b73f
-- 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
)
)
testsuite/tests/th/all.T
View file @
c190b73f
...
...
@@ -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
'])
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment