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
5f7e4514
Commit
5f7e4514
authored
Nov 21, 2002
by
simonpj
Browse files
[project @ 2002-11-21 09:37:24 by simonpj]
More wibbles to improve declaration splicing
parent
b8598510
Changes
4
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/deSugar/DsMeta.hs
View file @
5f7e4514
...
...
@@ -66,6 +66,7 @@ import TysWiredIn ( stringTy )
import
CoreSyn
import
CoreUtils
(
exprType
)
import
SrcLoc
(
noSrcLoc
)
import
Maybes
(
orElse
)
import
Maybe
(
catMaybes
,
fromMaybe
)
import
Panic
(
panic
)
import
Unique
(
mkPreludeTyConUnique
,
mkPreludeMiscIdUnique
)
...
...
@@ -143,7 +144,7 @@ repTopDs group
-- do { t :: String <- genSym "T" ;
-- return (Data t [] ...more t's... }
-- The other important reason is that the output must mention
-- only "T", not "Foo
.
T" where Foo is the current module
-- only "T", not "Foo
:
T" where Foo is the current module
decls
<-
addBinds
ss
(
do
{
...
...
@@ -214,17 +215,22 @@ repTyClD (TySynonym { tcdName = tc, tcdTyVars = tvs, tcdSynRhs = ty })
return
(
Just
dec
)
}
repTyClD
(
ClassDecl
{
tcdCtxt
=
cxt
,
tcdName
=
cls
,
tcdTyVars
=
tvs
,
tcdFDs
=
[]
,
tcdSigs
=
sigs
,
tcdMeths
=
Just
binds
})
=
do
cls1
<-
lookupOcc
cls
-- See note [Binders and occurrences]
dec
<-
addTyVarBinds
tvs
$
\
bndrs
->
do
cxt1
<-
repContext
cxt
sigs1
<-
rep_sigs
sigs
binds1
<-
rep_monobind
binds
decls1
<-
coreList
declTyConName
(
sigs1
++
binds1
)
repClass
cxt1
cls1
(
coreList'
stringTy
bndrs
)
decls1
return
$
Just
dec
tcdTyVars
=
tvs
,
tcdFDs
=
[]
,
-- We don't understand functional dependencies
tcdSigs
=
sigs
,
tcdMeths
=
mb_meth_binds
})
=
do
{
cls1
<-
lookupOcc
cls
;
-- See note [Binders and occurrences]
dec
<-
addTyVarBinds
tvs
$
\
bndrs
->
do
{
cxt1
<-
repContext
cxt
;
sigs1
<-
rep_sigs
sigs
;
binds1
<-
rep_monobind
meth_binds
;
decls1
<-
coreList
declTyConName
(
sigs1
++
binds1
)
;
repClass
cxt1
cls1
(
coreList'
stringTy
bndrs
)
decls1
}
;
return
$
Just
dec
}
where
-- If the user quotes a class decl, it'll have default-method
-- bindings; but if we (reifyDecl C) where C is a class, we
-- won't be given the default methods (a definite infelicity).
meth_binds
=
mb_meth_binds
`
orElse
`
EmptyMonoBinds
-- Un-handled cases
repTyClD
d
=
do
{
addDsWarn
(
hang
msg
4
(
ppr
d
))
;
...
...
@@ -293,7 +299,7 @@ rep_sig (ClassOpSig nm _ ty _) = rep_proto nm ty
rep_sig
(
Sig
nm
ty
_
)
=
rep_proto
nm
ty
rep_sig
other
=
return
[]
rep_proto
nm
ty
=
do
{
nm1
<-
lookup
Binder
nm
;
rep_proto
nm
ty
=
do
{
nm1
<-
lookup
Occ
nm
;
ty1
<-
repTy
ty
;
sig
<-
repProto
nm1
ty1
;
return
[
sig
]
}
...
...
ghc/compiler/hsSyn/Convert.lhs
View file @
5f7e4514
...
...
@@ -14,7 +14,7 @@ import Language.Haskell.THSyntax as Meta
import HsSyn as Hs
( HsExpr(..), HsLit(..), ArithSeqInfo(..),
HsStmtContext(..),
HsStmtContext(..),
TyClDecl(..),
Match(..), GRHSs(..), GRHS(..), HsPred(..),
HsDecl(..), TyClDecl(..), InstDecl(..), ConDecl(..),
Stmt(..), HsBinds(..), MonoBinds(..), Sig(..),
...
...
ghc/compiler/typecheck/TcRnDriver.lhs
View file @
5f7e4514
...
...
@@ -17,7 +17,7 @@ module TcRnDriver (
#ifdef GHCI
import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
import DsMeta (
qTyCon
Name )
import DsMeta (
templateHaskell
Name
s
)
#endif
import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
...
...
@@ -616,7 +616,7 @@ tcRnSrcDecls ds
(rn_splice_expr, fvs) <- initRn SourceMode $
addSrcLoc splice_loc $
rnExpr splice_expr ;
tcg_env <- importSupportingDecls (fvs `
addOneFV` qTyCon
Name) ;
tcg_env <- importSupportingDecls (fvs `
plusFV` templateHaskell
Name
s
) ;
setGblEnv tcg_env $ do {
-- Execute the splice
...
...
ghc/compiler/typecheck/TcSplice.lhs
View file @
5f7e4514
...
...
@@ -209,10 +209,8 @@ runMetaD :: TypecheckedHsExpr -- Of type Q [Dec]
-> TcM [Meta.Dec] -- Of type [Dec]
runMetaD e = runMeta e
-- Warning: if Q is anything other than IO, we need to change this
tcRunQ :: Meta.Q a -> TcM a
tcRunQ (Meta.Q thing) = ioToTcRn thing
tcRunQ thing = ioToTcRn (Meta.runQ thing)
runMeta :: TypecheckedHsExpr -- Of type X
-> TcM t -- Of type t
...
...
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