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
f0ec96ba
Commit
f0ec96ba
authored
Nov 04, 2003
by
simonpj
Browse files
[project @ 2003-11-04 13:15:20 by simonpj]
Beginnings of VarBr
parent
64446dd5
Changes
3
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/deSugar/DsMeta.hs
View file @
f0ec96ba
...
...
@@ -88,6 +88,7 @@ dsBracket brack splices
where
new_bit
=
mkNameEnv
[(
n
,
Splice
e
)
|
(
n
,
e
)
<-
splices
]
do_brack
(
VarBr
n
)
=
do
{
MkC
e1
<-
lookupOcc
n
;
return
e1
}
do_brack
(
ExpBr
e
)
=
do
{
MkC
e1
<-
repE
e
;
return
e1
}
do_brack
(
PatBr
p
)
=
do
{
MkC
p1
<-
repP
p
;
return
p1
}
do_brack
(
TypBr
t
)
=
do
{
MkC
t1
<-
repTy
t
;
return
t1
}
...
...
ghc/compiler/hsSyn/HsExpr.lhs
View file @
f0ec96ba
...
...
@@ -811,10 +811,11 @@ pprComp brack stmts = brack $
%************************************************************************
\begin{code}
data HsBracket id = ExpBr (HsExpr id)
| PatBr (Pat id)
| DecBr (HsGroup id)
| TypBr (HsType id)
data HsBracket id = ExpBr (HsExpr id) -- [| expr |]
| PatBr (Pat id) -- [p| pat |]
| DecBr (HsGroup id) -- [d| decls |]
| TypBr (HsType id) -- [t| type |]
| VarBr id -- 'x, ''T
instance OutputableBndr id => Outputable (HsBracket id) where
ppr = pprHsBracket
...
...
@@ -824,7 +825,11 @@ pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
pprHsBracket (VarBr n) = char '\'' <> ppr n
-- Infelicity: can't show ' vs '', because
-- we can't ask n what its OccName is, because the
-- pretty-printer for HsExpr doesn't ask for NamedThings
-- But the pretty-printer for names will show the OccName class
thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
pp_body <+> ptext SLIT("|]")
...
...
ghc/compiler/typecheck/TcSplice.lhs
View file @
f0ec96ba
...
...
@@ -96,6 +96,11 @@ tcBracket brack res_ty
}
tc_bracket :: HsBracket Name -> TcM TcType
tc_bracket (ExpBr v)
= panic "tc_bracket"
-- tcMetaTy varTyConName
-- Result type is Var (not Q-monadic)
tc_bracket (ExpBr expr)
= newTyVarTy openTypeKind `thenM` \ any_ty ->
tcCheckRho expr any_ty `thenM_`
...
...
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