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
eb9bbe10
Commit
eb9bbe10
authored
Oct 30, 2002
by
simonpj
Browse files
[project @ 2002-10-30 13:16:40 by simonpj]
Add string/rational literals, and e::t form to TH
parent
8a82d183
Changes
3
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/deSugar/DsMeta.hs
View file @
eb9bbe10
...
...
@@ -20,8 +20,8 @@ module DsMeta( dsBracket, dsReify,
import
{-#
SOURCE
#-
}
DsExpr
(
dsExpr
)
import
DsUtils
(
mkListExpr
,
mkStringLit
,
mkCoreTup
,
mkIntExpr
,
mkChar
Expr
)
import
MatchLit
(
dsLit
)
import
DsUtils
(
mkListExpr
,
mkStringLit
,
mkCoreTup
,
mkInt
Expr
)
import
DsMonad
import
qualified
Language.Haskell.THSyntax
as
M
...
...
@@ -319,12 +319,12 @@ repE (HsVar x) =
Just
(
Bound
y
)
->
repVarOrCon
x
(
coreVar
y
)
Just
(
Splice
e
)
->
do
{
e'
<-
dsExpr
e
;
return
(
MkC
e'
)
}
}
repE
(
HsIPVar
x
)
=
panic
"DsMeta.repE: Can't represent implicit parameters"
repE
(
Hs
OverLit
l
)
=
do
{
a
<-
repOverloadedLiteral
l
;
repLit
a
}
repE
(
Hs
Lit
l
)
=
do
{
a
<-
rep
Literal
l
;
rep
Lit
a
}
repE
(
HsLam
m
)
=
repLambda
m
repE
(
HsApp
x
y
)
=
do
{
a
<-
repE
x
;
b
<-
repE
y
;
repApp
a
b
}
repE
(
HsIPVar
x
)
=
panic
"DsMeta.repE: Can't represent implicit parameters"
repE
(
HsLit
l
)
=
do
{
a
<-
repLiteral
l
;
repLit
a
}
repE
(
Hs
Lam
m
)
=
repLambd
a
m
repE
(
Hs
App
x
y
)
=
do
{
a
<-
rep
E
x
;
b
<-
repE
y
;
rep
App
a
b
}
-- HsOverLit l never happens (if it does, the catch-all will find it)
repE
(
OpApp
e1
op
fix
e2
)
=
case
op
of
HsVar
op
->
do
{
arg1
<-
repE
e1
;
...
...
@@ -367,8 +367,8 @@ repE (ExplicitTuple es boxed)
|
otherwise
=
panic
"DsMeta.repE: Can't represent unboxed tuples"
repE
(
RecordConOut
_
_
_
)
=
panic
"DsMeta.repE: No record construction yet"
repE
(
RecordUpdOut
_
_
_
_
)
=
panic
"DsMeta.repE: No record update yet"
repE
(
ExprWithTySig
e
ty
)
=
panic
"DsMeta.repE: No expressions with type signatures yet"
repE
(
ExprWithTySig
e
ty
)
=
do
{
e1
<-
repE
e
;
t1
<-
repTy
ty
;
repSigExp
e1
t1
}
repE
(
ArithSeqOut
_
aseq
)
=
case
aseq
of
From
e
->
do
{
ds1
<-
repE
e
;
repFrom
ds1
}
...
...
@@ -786,6 +786,9 @@ repComp (MkC ss) = rep2 compName [ss]
repListExp
::
Core
[
M
.
Expr
]
->
DsM
(
Core
M
.
Expr
)
repListExp
(
MkC
es
)
=
rep2
listExpName
[
es
]
repSigExp
::
Core
M
.
Expr
->
Core
M
.
Type
->
DsM
(
Core
M
.
Expr
)
repSigExp
(
MkC
e
)
(
MkC
t
)
=
rep2
sigExpName
[
e
,
t
]
repInfixApp
::
Core
M
.
Expr
->
Core
String
->
Core
M
.
Expr
->
DsM
(
Core
M
.
Expr
)
repInfixApp
(
MkC
x
)
(
MkC
y
)
(
MkC
z
)
=
rep2
infixAppName
[
x
,
y
,
z
]
...
...
@@ -889,13 +892,17 @@ repListTyCon = rep2 listTyConName []
-- Literals
repLiteral
::
HsLit
->
DsM
(
Core
M
.
Lit
)
repLiteral
(
HsInt
i
)
=
rep2
intLName
[
mkIntExpr
i
]
repLiteral
(
HsChar
c
)
=
rep2
charLName
[
mkCharExpr
c
]
repLiteral
x
=
panic
"trying to represent exotic literal"
repOverloadedLiteral
::
HsOverLit
->
DsM
(
Core
M
.
Lit
)
repOverloadedLiteral
(
HsIntegral
i
_
)
=
rep2
intLName
[
mkIntExpr
i
]
repOverloadedLiteral
(
HsFractional
f
_
)
=
panic
"Cant do fractional literals yet"
repLiteral
lit
=
do
{
lit_expr
<-
dsLit
lit
;
rep2
lit_name
[
lit_expr
]
}
where
lit_name
=
case
lit
of
HsInt
_
->
intLName
HsChar
_
->
charLName
HsString
_
->
stringLName
HsRat
_
_
->
rationalLName
other
->
uh_oh
uh_oh
=
pprPanic
"DsMeta.repLiteral: trying to represent exotic literal"
(
ppr
lit
)
--------------- Miscellaneous -------------------
...
...
@@ -976,11 +983,12 @@ templateHaskellNames :: NameSet
-- The names that are implicitly mentioned by ``bracket''
-- Should stay in sync with the import list of DsMeta
templateHaskellNames
=
mkNameSet
[
intLName
,
charLName
,
plitName
,
pvarName
,
ptupName
,
=
mkNameSet
[
intLName
,
charLName
,
stringLName
,
rationalLName
,
plitName
,
pvarName
,
ptupName
,
pconName
,
ptildeName
,
paspatName
,
pwildName
,
varName
,
conName
,
litName
,
appName
,
infixEName
,
lamName
,
tupName
,
doEName
,
compName
,
listExpName
,
condName
,
letEName
,
caseEName
,
listExpName
,
sigExpName
,
condName
,
letEName
,
caseEName
,
infixAppName
,
negName
,
sectionLName
,
sectionRName
,
guardedName
,
normalName
,
bindStName
,
letStName
,
noBindStName
,
parStName
,
...
...
@@ -1009,6 +1017,8 @@ mk_known_key_name space str uniq
intLName
=
varQual
FSLIT
(
"intL"
)
intLIdKey
charLName
=
varQual
FSLIT
(
"charL"
)
charLIdKey
stringLName
=
varQual
FSLIT
(
"stringL"
)
stringLIdKey
rationalLName
=
varQual
FSLIT
(
"rationalL"
)
rationalLIdKey
plitName
=
varQual
FSLIT
(
"plit"
)
plitIdKey
pvarName
=
varQual
FSLIT
(
"pvar"
)
pvarIdKey
ptupName
=
varQual
FSLIT
(
"ptup"
)
ptupIdKey
...
...
@@ -1026,6 +1036,7 @@ tupName = varQual FSLIT("tup") tupIdKey
doEName
=
varQual
FSLIT
(
"doE"
)
doEIdKey
compName
=
varQual
FSLIT
(
"comp"
)
compIdKey
listExpName
=
varQual
FSLIT
(
"listExp"
)
listExpIdKey
sigExpName
=
varQual
FSLIT
(
"sigExp"
)
sigExpIdKey
condName
=
varQual
FSLIT
(
"cond"
)
condIdKey
letEName
=
varQual
FSLIT
(
"letE"
)
letEIdKey
caseEName
=
varQual
FSLIT
(
"caseE"
)
caseEIdKey
...
...
@@ -1177,6 +1188,13 @@ namedTyConIdKey = mkPreludeMiscIdUnique 257
constrIdKey
=
mkPreludeMiscIdUnique
258
stringLIdKey
=
mkPreludeMiscIdUnique
259
rationalLIdKey
=
mkPreludeMiscIdUnique
260
sigExpIdKey
=
mkPreludeMiscIdUnique
261
-- %************************************************************************
-- %* *
-- Other utilities
...
...
ghc/compiler/deSugar/DsUtils.lhs
View file @
eb9bbe10
...
...
@@ -401,9 +401,11 @@ mkErrorAppDs err_id ty msg
%************************************************************************
\begin{code}
mkCharExpr :: Int -> CoreExpr -- Returns C# c :: Int
mkIntExpr :: Integer -> CoreExpr -- Returns I# i :: Int
mkIntegerExpr :: Integer -> DsM CoreExpr -- Result :: Integer
mkCharExpr :: Int -> CoreExpr -- Returns C# c :: Int
mkIntExpr :: Integer -> CoreExpr -- Returns I# i :: Int
mkIntegerExpr :: Integer -> DsM CoreExpr -- Result :: Integer
mkStringLit :: String -> DsM CoreExpr -- Result :: String
mkStringLitFS :: FastString -> DsM CoreExpr -- Result :: String
mkIntExpr i = mkConApp intDataCon [mkIntLit i]
mkCharExpr c = mkConApp charDataCon [mkLit (MachChar c)]
...
...
@@ -438,10 +440,8 @@ mkIntegerExpr i
mkSmallIntegerLit i = mkConApp smallIntegerDataCon [mkIntLit i]
mkStringLit :: String -> DsM CoreExpr
mkStringLit str = mkStringLitFS (mkFastString str)
mkStringLitFS :: FastString -> DsM CoreExpr
mkStringLitFS str
| nullFastString str
= returnDs (mkNilExpr charTy)
...
...
ghc/compiler/hsSyn/Convert.lhs
View file @
eb9bbe10
...
...
@@ -26,7 +26,7 @@ import HsSyn as Hs
import RdrName ( RdrName, mkRdrUnqual, mkRdrQual, mkOrig )
import Module ( mkModuleName )
import RdrHsSyn ( mkHsIntegral, mkClassDecl, mkTyData )
import RdrHsSyn ( mkHsIntegral,
mkHsFractional,
mkClassDecl, mkTyData )
import OccName
import SrcLoc ( SrcLoc, generatedSrcLoc )
import TyCon ( DataConDetails(..) )
...
...
@@ -173,11 +173,14 @@ cvtpair (x,y) = GRHS [BindStmt truePat (cvt x) loc0,
ResultStmt (cvt y) loc0] loc0
cvtOverLit :: Lit -> HsOverLit
cvtOverLit (Int i) = mkHsIntegral (fromInt i)
cvtOverLit (Int i) = mkHsIntegral (fromInt i)
cvtOverLit (Rational r) = mkHsFractional r
-- An Int is like an an (overloaded) '3' in a Haskell source program
-- Similarly 3.5 for fractionals
cvtLit :: Lit -> HsLit
cvtLit (Char c) = HsChar (ord c)
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