Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
dc77f191
Commit
dc77f191
authored
May 04, 2003
by
igloo
Browse files
[project @ 2003-05-04 13:21:48 by igloo]
Add support for unboxed Ints, Floats and Doubles to Template Haskell.
parent
371b4d98
Changes
2
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/deSugar/DsMeta.hs
View file @
dc77f191
...
...
@@ -1118,15 +1118,27 @@ repListTyCon = rep2 listTyConName []
repLiteral
::
HsLit
->
DsM
(
Core
M
.
Lit
)
repLiteral
lit
=
do
{
lit_expr
<-
dsLit
lit
;
rep2
lit_name
[
lit_expr
]
}
=
do
lit'
<-
case
lit
of
HsIntPrim
i
->
return
$
HsInteger
i
HsInt
i
->
return
$
HsInteger
i
HsFloatPrim
r
->
do
rat_ty
<-
lookupType
rationalTyConName
return
$
HsRat
r
rat_ty
HsDoublePrim
r
->
do
rat_ty
<-
lookupType
rationalTyConName
return
$
HsRat
r
rat_ty
_
->
return
lit
lit_expr
<-
dsLit
lit'
rep2
lit_name
[
lit_expr
]
where
lit_name
=
case
lit
of
HsInteger
_
->
integerLName
HsInt
_
->
integerLName
HsChar
_
->
charLName
HsString
_
->
stringLName
HsRat
_
_
->
rationalLName
other
->
uh_oh
HsInteger
_
->
integerLName
HsInt
_
->
integerLName
HsIntPrim
_
->
intPrimLName
HsFloatPrim
_
->
floatPrimLName
HsDoublePrim
_
->
doublePrimLName
HsChar
_
->
charLName
HsString
_
->
stringLName
HsRat
_
_
->
rationalLName
other
->
uh_oh
uh_oh
=
pprPanic
"DsMeta.repLiteral: trying to represent exotic literal"
(
ppr
lit
)
...
...
@@ -1200,7 +1212,8 @@ templateHaskellNames :: NameSet
-- The names that are implicitly mentioned by ``bracket''
-- Should stay in sync with the import list of DsMeta
templateHaskellNames
=
mkNameSet
[
integerLName
,
charLName
,
stringLName
,
rationalLName
,
=
mkNameSet
[
intPrimLName
,
floatPrimLName
,
doublePrimLName
,
integerLName
,
charLName
,
stringLName
,
rationalLName
,
plitName
,
pvarName
,
ptupName
,
pconName
,
ptildeName
,
paspatName
,
pwildName
,
varName
,
conName
,
litName
,
appName
,
infixEName
,
lamName
,
...
...
@@ -1236,6 +1249,9 @@ thModule = mkThPkgModule mETA_META_Name
mk_known_key_name
space
str
uniq
=
mkKnownKeyExternalName
thModule
(
mkOccFS
space
str
)
uniq
intPrimLName
=
varQual
FSLIT
(
"intPrimL"
)
intPrimLIdKey
floatPrimLName
=
varQual
FSLIT
(
"floatPrimL"
)
floatPrimLIdKey
doublePrimLName
=
varQual
FSLIT
(
"doublePrimL"
)
doublePrimLIdKey
integerLName
=
varQual
FSLIT
(
"integerL"
)
integerLIdKey
charLName
=
varQual
FSLIT
(
"charL"
)
charLIdKey
stringLName
=
varQual
FSLIT
(
"stringL"
)
stringLIdKey
...
...
@@ -1460,6 +1476,10 @@ precIdKey = mkPreludeMiscIdUnique 272
fieldKey
=
mkPreludeMiscIdUnique
273
fieldPKey
=
mkPreludeMiscIdUnique
274
intPrimLIdKey
=
mkPreludeMiscIdUnique
275
floatPrimLIdKey
=
mkPreludeMiscIdUnique
276
doublePrimLIdKey
=
mkPreludeMiscIdUnique
277
-- %************************************************************************
-- %* *
-- Other utilities
...
...
ghc/compiler/hsSyn/Convert.lhs
View file @
dc77f191
...
...
@@ -258,8 +258,11 @@ cvtOverLit (Rational r) = mkHsFractional r
-- Similarly 3.5 for fractionals
cvtLit :: Lit -> HsLit
cvtLit (Char c) = HsChar (ord c)
cvtLit (String s) = HsString (mkFastString s)
cvtLit (IntPrim i) = HsIntPrim i
cvtLit (FloatPrim f) = HsFloatPrim f
cvtLit (DoublePrim f) = HsDoublePrim f
cvtLit (Char c) = HsChar (ord c)
cvtLit (String s) = HsString (mkFastString s)
cvtp :: Meta.Pat -> Hs.Pat RdrName
cvtp (Plit l)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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