Commit 639714ba authored by gmainland's avatar gmainland
Browse files

Differentiate typed and untyped splices and brackets in the abstract syntax.

parent 96456c69
......@@ -82,6 +82,7 @@ dsBracket brack splices
do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
do_brack (DecBrG gp) = do { MkC ds1 <- repTopDs gp ; return ds1 }
do_brack (DecBrL _) = panic "dsBracket: unexpected DecBrL"
do_brack (TExpBr e) = do { MkC e1 <- repLE e ; return e1 }
{- -------------- Examples --------------------
......@@ -901,7 +902,7 @@ repRole (L _ Nothing) = rep2 inferRName []
repSplice :: HsSplice Name -> DsM (Core a)
-- See Note [How brackets and nested splices are handled] in TcSplice
-- We return a CoreExpr of any old type; the context should know
repSplice (HsSplice n _)
repSplice (HsSplice _ n _)
= do { mb_val <- dsLookupMetaEnv n
; case mb_val of
Just (Splice e) -> do { e' <- dsExpr e
......
......@@ -1318,6 +1318,7 @@ pprQuals quals = interpp'SP quals
\begin{code}
data HsSplice id = HsSplice -- $z or $(f 4)
Bool -- True if typed, False if untyped
id -- The id is just a unique name to
(LHsExpr id) -- identify this splice point
deriving (Data, Typeable)
......@@ -1326,8 +1327,9 @@ instance OutputableBndr id => Outputable (HsSplice id) where
ppr = pprSplice
pprSplice :: OutputableBndr id => HsSplice id -> SDoc
pprSplice (HsSplice n e)
= char '$' <> ifPprDebug (brackets (ppr n)) <> eDoc
pprSplice (HsSplice isTyped n e)
= (if isTyped then ptext (sLit "$$") else char '$')
<> ifPprDebug (brackets (ppr n)) <> eDoc
where
-- We use pprLExpr to match pprParendExpr:
-- Using pprLExpr makes sure that we go 'deeper'
......@@ -1345,6 +1347,7 @@ data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
| TypBr (LHsType id) -- [t| type |]
| VarBr Bool id -- True: 'x, False: ''T
-- (The Bool flag is used only in pprHsBracket)
| TExpBr (LHsExpr id) -- [|| expr ||]
deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsBracket id) where
......@@ -1359,10 +1362,14 @@ pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
pprHsBracket (VarBr True n) = char '\'' <> ppr n
pprHsBracket (VarBr False n) = ptext (sLit "''") <> ppr n
pprHsBracket (TExpBr e) = thTyBrackets (ppr e)
thBrackets :: SDoc -> SDoc -> SDoc
thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
pp_body <+> ptext (sLit "|]")
thTyBrackets :: SDoc -> SDoc
thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]")
\end{code}
%************************************************************************
......
......@@ -54,7 +54,7 @@ module HsUtils(
emptyRecStmt, mkRecStmt,
-- Template Haskell
unqualSplice, mkHsSpliceTy, mkHsSplice, mkHsQuasiQuote, unqualQuasiQuote,
unqualSplice, mkHsSpliceTy, mkHsSplice, mkHsTExpSplice, mkHsQuasiQuote, unqualQuasiQuote,
-- Flags
noRebindableInfo,
......@@ -247,7 +247,10 @@ mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
mkHsSplice e = HsSplice unqualSplice e
mkHsSplice e = HsSplice False unqualSplice e
mkHsTExpSplice :: LHsExpr RdrName -> HsSplice RdrName
mkHsTExpSplice e = HsSplice True unqualSplice e
mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) emptyFVs placeHolderKind
......
......@@ -1556,10 +1556,10 @@ aexp2 :: { LHsExpr RdrName }
(L1 $ HsVar (mkUnqual varName
(getTH_ID_SPLICE $1)))) }
| '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) }
| TH_ID_TY_SPLICE { L1 $ HsSpliceE (mkHsSplice
| TH_ID_TY_SPLICE { L1 $ HsSpliceE (mkHsTExpSplice
(L1 $ HsVar (mkUnqual varName
(getTH_ID_TY_SPLICE $1)))) }
| '$$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) }
| '$$(' exp ')' { LL $ HsSpliceE (mkHsTExpSplice $2) }
| SIMPLEQUOTE qvar { LL $ HsBracket (VarBr True (unLoc $2)) }
......@@ -1567,7 +1567,7 @@ aexp2 :: { LHsExpr RdrName }
| TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr False (unLoc $2)) }
| TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr False (unLoc $2)) }
| '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
| '[||' exp '||]' { LL $ HsBracket (ExpBr $2) }
| '[||' exp '||]' { LL $ HsBracket (TExpBr $2) }
| '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) }
| '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
return (LL $ HsBracket (PatBr p)) }
......
......@@ -222,9 +222,9 @@ mkTopSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
-- but if she wrote, say,
-- f x then behave as if she'd written $(f x)
-- ie a SpliceD
mkTopSpliceDecl (L _ (HsQuasiQuoteE qq)) = QuasiQuoteD qq
mkTopSpliceDecl (L _ (HsSpliceE (HsSplice _ expr))) = SpliceD (SpliceDecl expr Explicit)
mkTopSpliceDecl other_expr = SpliceD (SpliceDecl other_expr Implicit)
mkTopSpliceDecl (L _ (HsQuasiQuoteE qq)) = QuasiQuoteD qq
mkTopSpliceDecl (L _ (HsSpliceE (HsSplice _ _ expr))) = SpliceD (SpliceDecl expr Explicit)
mkTopSpliceDecl other_expr = SpliceD (SpliceDecl other_expr Implicit)
-- Ensure a type literal is used correctly; notably, we need the proper extension enabled,
-- and if it's an integer literal, the literal must be >= 0. This can occur with
......
......@@ -52,7 +52,7 @@ type checker. Not very satisfactory really.
\begin{code}
rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
rnSplice (HsSplice n expr)
rnSplice (HsSplice isTyped n expr)
= do { checkTH expr "splice"
; loc <- getSrcSpanM
; n' <- newLocalBndrRn (L loc n)
......@@ -65,7 +65,7 @@ rnSplice (HsSplice n expr)
isLocalGRE gre]
lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
; return (HsSplice isTyped n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
\end{code}
\begin{code}
......@@ -159,4 +159,7 @@ rn_bracket (DecBrL decls)
; return (DecBrG group', duUses (tcg_dus tcg_env)) }
rn_bracket (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
rn_bracket (TExpBr e) = do { (e', fvs) <- rnLExpr e
; return (TExpBr e', fvs) }
\end{code}
......@@ -424,6 +424,12 @@ tc_bracket _ (PatBr pat)
tc_bracket _ (DecBrL _)
= panic "tc_bracket: Unexpected DecBrL"
tc_bracket _ (TExpBr expr)
= do { any_ty <- newFlexiTyVarTy openTypeKind
; _ <- tcMonoExprNC expr any_ty -- NC for no context; tcBracket does that
; tcMetaTy expQTyConName }
-- Result type is ExpQ (= Q Exp)
quotedNameStageErr :: HsBracket Name -> SDoc
quotedNameStageErr br
= sep [ ptext (sLit "Stage error: the non-top-level quoted name") <+> ppr br
......@@ -438,7 +444,7 @@ quotedNameStageErr br
%************************************************************************
\begin{code}
tcSpliceExpr (HsSplice name expr) res_ty
tcSpliceExpr (HsSplice _ name expr) res_ty
= setSrcSpan (getLoc expr) $ do
{ stage <- getStage
; case stage of {
......@@ -538,7 +544,7 @@ We don't want the type checker to see these bogus unbound variables.
Very like splicing an expression, but we don't yet share code.
\begin{code}
tcSpliceType (HsSplice name hs_expr) _
tcSpliceType (HsSplice _ name hs_expr) _
= setSrcSpan (getLoc hs_expr) $ do
{ stage <- getStage
; case stage of {
......
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