Commit 6a1c05f0 authored by Simon Peyton Jones's avatar Simon Peyton Jones

A little refactoring of HsSplice and friends

Plus adding comments.

The most substantive change is that PendingTcSplice becomes a proper
data type rather than a pair; and PendingRnSplice uses it
parent 64dc4d10
......@@ -77,7 +77,7 @@ dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr
dsBracket brack splices
= dsExtendMetaEnv new_bit (do_brack brack)
where
new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n, e) <- splices]
new_bit = mkNameEnv [(n, Splice (unLoc e)) | PendSplice n e <- splices]
do_brack (VarBr _ n) = do { MkC e1 <- lookupOcc n ; return e1 }
do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
......
......@@ -350,57 +350,8 @@ deriving instance (DataId id) => Data (HsTupArg id)
tupArgPresent :: HsTupArg id -> Bool
tupArgPresent (Present {}) = True
tupArgPresent (Missing {}) = False
-- See Note [Pending Splices]
data PendingRnSplice
= PendingRnExpSplice (HsSplice Name)
| PendingRnPatSplice (HsSplice Name)
| PendingRnTypeSplice (HsSplice Name)
| PendingRnDeclSplice (HsSplice Name)
| PendingRnCrossStageSplice Name
deriving (Data, Typeable)
type PendingTcSplice = (Name, LHsExpr Id)
\end{code}
Note [Pending Splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Now that untyped brackets are not type checked, we need a mechanism to ensure
that splices contained in untyped brackets *are* type checked. Therefore the
renamer now renames every HsBracket into a HsRnBracketOut, which contains the
splices that need to be type checked. There are four varieties of pending
splices generated by the renamer:
* Pending expression splices (PendingRnExpSplice), e.g.,
[|$(f x) + 2|]
* Pending pattern splices (PendingRnPatSplice), e.g.,
[|\ $(f x) -> x|]
* Pending type splices (PendingRnTypeSplice), e.g.,
[|f :: $(g x)|]
* Pending cross-stage splices (PendingRnCrossStageSplice), e.g.,
\x -> [| x |]
There is a fifth variety of pending splice, which is generated by the type
checker:
* Pending *typed* expression splices, (PendingTcSplice), e.g.,
[||1 + $$(f 2)||]
It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
output of the renamer. However, when pretty printing the output of the renamer,
e.g., in a type error message, we *do not* want to print out the pending
splices. In contrast, when pretty printing the output of the type checker, we
*do* want to print the pending splices. So splitting them up seems to make
sense, although I hate to add another constructor to HsExpr.
Note [Parens in HsSyn]
~~~~~~~~~~~~~~~~~~~~~~
HsPar (and ParPat in patterns, HsParTy in types) is used as follows
......@@ -1387,15 +1338,98 @@ pprQuals quals = interpp'SP quals
%************************************************************************
\begin{code}
data HsSplice id = HsSplice -- $z or $(f 4)
id -- The id is just a unique name to
(LHsExpr id) -- identify this splice point
deriving (Typeable)
data HsSplice id
= HsSplice -- $z or $(f 4)
id -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
deriving (Typeable )
-- See Note [Pending Splices]
data PendingSplice id
= PendSplice Name (LHsExpr id)
deriving( Typeable )
-- It'd be convenient to re-use HsSplice, but the splice-name
-- really is a Name, never an Id. Using (PostRn id Name) is
-- nearly OK, but annoyingly we can't pretty-print it.
data PendingRnSplice
= PendingRnExpSplice (PendingSplice Name)
| PendingRnPatSplice (PendingSplice Name)
| PendingRnTypeSplice (PendingSplice Name)
| PendingRnDeclSplice (PendingSplice Name)
| PendingRnCrossStageSplice Name
deriving (Data, Typeable)
type PendingTcSplice = PendingSplice Id
deriving instance (DataId id) => Data (HsSplice id)
deriving instance (DataId id) => Data (PendingSplice id)
\end{code}
Note [Pending Splices]
~~~~~~~~~~~~~~~~~~~~~~
When we rename an untyped bracket, we name and lift out all the nested
splices, so that when the typechecker hits the bracket, it can
typecheck those nested splices without having to walk over the untyped
bracket code. So for example
[| f $(g x) |]
looks like
HsBracket (HsApp (HsVar "f") (HsSpliceE _ (g x)))
which the renamer rewrites to
HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))
[PendingRnExpSplice (HsSplice sn (g x))]
* The 'sn' is the Name of the splice point.
* The PendingRnExpSplice gives the splice that splice-point name maps to;
and the typechecker can now conveniently find these sub-expressions
* The other copy of the splice, in the second argument of HsSpliceE
in the renamed first arg of HsRnBracketOut
is used only for pretty printing
There are four varieties of pending splices generated by the renamer:
* Pending expression splices (PendingRnExpSplice), e.g.,
[|$(f x) + 2|]
* Pending pattern splices (PendingRnPatSplice), e.g.,
[|\ $(f x) -> x|]
* Pending type splices (PendingRnTypeSplice), e.g.,
[|f :: $(g x)|]
* Pending cross-stage splices (PendingRnCrossStageSplice), e.g.,
\x -> [| x |]
There is a fifth variety of pending splice, which is generated by the type
checker:
* Pending *typed* expression splices, (PendingTcSplice), e.g.,
[||1 + $$(f 2)||]
It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
output of the renamer. However, when pretty printing the output of the renamer,
e.g., in a type error message, we *do not* want to print out the pending
splices. In contrast, when pretty printing the output of the type checker, we
*do* want to print the pending splices. So splitting them up seems to make
sense, although I hate to add another constructor to HsExpr.
\begin{code}
instance OutputableBndr id => Outputable (HsSplice id) where
ppr (HsSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
instance OutputableBndr id => Outputable (PendingSplice id) where
ppr (PendSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
pprUntypedSplice :: OutputableBndr id => HsSplice id -> SDoc
pprUntypedSplice = pprSplice False
......
......@@ -282,6 +282,9 @@ mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
mkHsSplice e = HsSplice unqualSplice e
unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
mkHsSpliceE :: LHsExpr RdrName -> HsExpr RdrName
mkHsSpliceE e = HsSpliceE False (mkHsSplice e)
......@@ -291,11 +294,6 @@ mkHsSpliceTE e = HsSpliceE True (mkHsSplice e)
mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) placeHolderKind
unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
-- A name (uniquified later) to
-- identify the splice
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
......
......@@ -68,19 +68,21 @@ rnSpliceDecl e = failTH e "Template Haskell declaration splice"
%* *
%*********************************************************
Note [Splices]
~~~~~~~~~~~~~~
Consider
Note [Free variables of typed splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider renaming this:
f = ...
h = ...$(thing "f")...
The splice can expand into literally anything, so when we do dependency
analysis we must assume that it might mention 'f'. So we simply treat
all locally-defined names as mentioned by any splice. This is terribly
brutal, but I don't see what else to do. For example, it'll mean
that every locally-defined thing will appear to be used, so no unused-binding
warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
and that will crash the type checker because 'f' isn't in scope.
where the splice is a *typed* splice. The splice can expand into
literally anything, so when we do dependency analysis we must assume
that it might mention 'f'. So we simply treat all locally-defined
names as mentioned by any splice. This is terribly brutal, but I
don't see what else to do. For example, it'll mean that every
locally-defined thing will appear to be used, so no unused-binding
warnings. But if we miss the dependency, then we might typecheck 'h'
before 'f', and that will crash the type checker because 'f' isn't in
scope.
Currently, I'm not treating a splice as also mentioning every import,
which is a bit inconsistent -- but there are a lot of them. We might
......@@ -130,22 +132,21 @@ rnSpliceGen is_typed_splice run_splice pend_splice splice@(HsSplice _ expr)
---------------------
rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
-- Not exported...used for all
rnSplice (HsSplice n expr)
rnSplice (HsSplice splice_name expr)
= do { checkTH expr "Template Haskell splice"
; loc <- getSrcSpanM
; n' <- newLocalBndrRn (L loc n)
; n' <- newLocalBndrRn (L loc splice_name)
; (expr', fvs) <- rnLExpr expr
; return (HsSplice n' expr', fvs) }
---------------------
rnSpliceExpr :: Bool -> HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
rnSpliceExpr is_typed splice
= rnSpliceGen is_typed run_expr_splice pend_expr_splice splice
where
pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
pend_expr_splice rn_splice
= (PendingRnExpSplice rn_splice, HsSpliceE is_typed rn_splice)
pend_expr_splice rn_splice@(HsSplice n e)
= (PendingRnExpSplice (PendSplice n e), HsSpliceE is_typed rn_splice)
run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
run_expr_splice rn_splice@(HsSplice _ expr')
......@@ -183,8 +184,8 @@ rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
rnSpliceType splice k
= rnSpliceGen False run_type_splice pend_type_splice splice
where
pend_type_splice rn_splice
= (PendingRnTypeSplice rn_splice, HsSpliceTy rn_splice k)
pend_type_splice rn_splice@(HsSplice n e)
= (PendingRnTypeSplice (PendSplice n e), HsSpliceTy rn_splice k)
run_type_splice (HsSplice _ expr')
= do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
......@@ -210,8 +211,8 @@ rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
rnSplicePat splice
= rnSpliceGen False run_pat_splice pend_pat_splice splice
where
pend_pat_splice rn_splice
= (PendingRnPatSplice rn_splice, SplicePat rn_splice)
pend_pat_splice rn_splice@(HsSplice n e)
= (PendingRnPatSplice (PendSplice n e), SplicePat rn_splice)
run_pat_splice (HsSplice _ expr')
= do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
......@@ -236,8 +237,8 @@ rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
rnSpliceDecl (SpliceDecl (L loc splice) flg)
= rnSpliceGen False run_decl_splice pend_decl_splice splice
where
pend_decl_splice rn_splice
= (PendingRnDeclSplice rn_splice, SpliceDecl(L loc rn_splice) flg)
pend_decl_splice rn_splice@(HsSplice n e)
= (PendingRnDeclSplice (PendSplice n e), SpliceDecl(L loc rn_splice) flg)
run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
\end{code}
......
......@@ -1319,7 +1319,8 @@ checkCrossStageLifting id (Brack _ (TcPending ps_var lie_var))
-- Update the pending splices
; ps <- readMutVar ps_var
; writeMutVar ps_var ((idName id, nlHsApp (noLoc lift) (nlHsVar id)) : ps)
; let pending_splice = PendSplice (idName id) (nlHsApp (noLoc lift) (nlHsVar id))
; writeMutVar ps_var (pending_splice : ps)
; return () }
......
......@@ -602,8 +602,8 @@ zonkExpr env (HsTcBracketOut body bs)
= do bs' <- mapM zonk_b bs
return (HsTcBracketOut body bs')
where
zonk_b (n, e) = do e' <- zonkLExpr env e
return (n, e')
zonk_b (PendSplice n e) = do e' <- zonkLExpr env e
return (PendSplice n e')
zonkExpr _ (HsSpliceE t s) = WARN( True, ppr s ) -- Should not happen
return (HsSpliceE t s)
......
......@@ -590,7 +590,7 @@ pass it inwards.
---------------------------
data ThStage -- See Note [Template Haskell state diagram] in TcSplice
= Splice -- Top-level splicing
= Splice -- Inside a top-level splice splice
-- This code will be run *at compile time*;
-- the result replaces the splice
-- Binding level = 0
......@@ -609,7 +609,7 @@ data PendingStuff
| RnPendingTyped -- Renaming the inside of a *typed* bracket
| TcPending -- Typechecking the iniside of a typed bracket
| TcPending -- Typechecking the inside of a typed bracket
(TcRef [PendingTcSplice]) -- Accumulate pending splices here
(TcRef WantedConstraints) -- and type constraints here
......
......@@ -248,7 +248,11 @@ Note [Template Haskell state diagram]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Here are the ThStages, s, their corresponding level numbers
(the result of (thLevel s)), and their state transitions.
The top level of the program is stage Comp:
Start here
|
V
----------- $ ------------ $
| Comp | ---------> | Splice | -----|
| 1 | | 0 | <----|
......@@ -378,16 +382,16 @@ tcBrackTy (TExpBr _) = panic "tcUntypedBracket: Unexpected TExpBr"
---------------
tcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice
tcPendingSplice (PendingRnExpSplice (HsSplice n expr))
tcPendingSplice (PendingRnExpSplice (PendSplice n expr))
= do { res_ty <- tcMetaTy expQTyConName
; tc_pending_splice n expr res_ty }
tcPendingSplice (PendingRnPatSplice (HsSplice n expr))
tcPendingSplice (PendingRnPatSplice (PendSplice n expr))
= do { res_ty <- tcMetaTy patQTyConName
; tc_pending_splice n expr res_ty }
tcPendingSplice (PendingRnTypeSplice (HsSplice n expr))
tcPendingSplice (PendingRnTypeSplice (PendSplice n expr))
= do { res_ty <- tcMetaTy typeQTyConName
; tc_pending_splice n expr res_ty }
tcPendingSplice (PendingRnDeclSplice (HsSplice n expr))
tcPendingSplice (PendingRnDeclSplice (PendSplice n expr))
= do { res_ty <- tcMetaTy decsQTyConName
; tc_pending_splice n expr res_ty }
......@@ -400,7 +404,7 @@ tcPendingSplice (PendingRnCrossStageSplice n)
tc_pending_splice :: Name -> LHsExpr Name -> TcRhoType -> TcM PendingTcSplice
tc_pending_splice splice_name expr res_ty
= do { expr' <- tcMonoExpr expr res_ty
; return (splice_name, expr') }
; return (PendSplice splice_name expr') }
---------------
-- Takes a type tau and returns the type Q (TExp tau)
......@@ -440,7 +444,7 @@ tcNestedSplice pop_stage (TcPending ps_var lie_var) splice_name expr res_ty
; untypeq <- tcLookupId unTypeQName
; let expr'' = mkHsApp (nlHsTyApp untypeq [res_ty]) expr'
; ps <- readMutVar ps_var
; writeMutVar ps_var ((splice_name, expr'') : ps)
; writeMutVar ps_var (PendSplice splice_name expr'' : ps)
-- The returned expression is ignored; it's in the pending splices
; return (panic "tcSpliceExpr") }
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment