import SrcLoc
import Outputable
import Unique
-import Maybe
+import Data.Maybe
import BasicTypes
import Panic
import FastString
; tcSimplifyBracket lie
-- Make the expected type have the right shape
- ; boxyUnify meta_ty res_ty
+ ; _ <- boxyUnify meta_ty res_ty
-- Return the original expression, not the type-decorated one
; pendings <- readMutVar pending_splices
tc_bracket _ (ExpBr expr)
= do { any_ty <- newFlexiTyVarTy liftedTypeKind
- ; tcMonoExprNC expr any_ty -- NC for no context; tcBracket does that
+ ; _ <- tcMonoExprNC expr any_ty -- NC for no context; tcBracket does that
; tcMetaTy expQTyConName }
-- Result type is Expr (= Q Exp)
tc_bracket _ (TypBr typ)
- = do { tcHsSigTypeNC ThBrackCtxt typ
+ = do { _ <- tcHsSigTypeNC ThBrackCtxt typ
; tcMetaTy typeQTyConName }
-- Result type is Type (= Q Typ)
tc_bracket _ (DecBr decls)
- = do { tcTopSrcDecls emptyModDetails decls
+ = do { _ <- tcTopSrcDecls emptyModDetails decls
-- Typecheck the declarations, dicarding the result
-- We'll get all that stuff later, when we splice it in
-- Here (h 4) :: Q Exp
-- but $(h 4) :: forall a.a i.e. anything!
- unBox res_ty
+ _ <- unBox res_ty
meta_exp_ty <- tcMetaTy expQTyConName
expr' <- setStage (Splice next_level) (
setLIEVar lie_var $
traceTc (text "Got result" <+> ppr expr2)
- showSplice "expression"
- zonked_q_expr (ppr expr2)
+ showSplice "expression" expr (ppr expr2)
-- Rename it, but bale out if there are errors
-- otherwise the type checker just gives more spurious errors
; traceTc (text "About to run" <+> ppr zonked_q_expr)
; result <- runMetaQ convert zonked_q_expr
; traceTc (text "Got result" <+> ppr result)
- ; showSplice desc zonked_q_expr (ppr result)
+ ; showSplice desc quoteExpr (ppr result)
; return result
}
; traceTc (text "Got result" <+> ppr hs_ty2)
- ; showSplice "type" zonked_q_expr (ppr hs_ty2)
+ ; showSplice "type" expr (ppr hs_ty2)
-- Rename it, but bale out if there are errors
-- otherwise the type checker just gives more spurious errors
; traceTc (text "Got result" <+> vcat (map ppr decls))
; showSplice "declarations"
- zonked_q_expr
+ expr
(ppr (getLoc expr) $$ (vcat (map ppr decls)))
; return decls }
\end{code}
%************************************************************************
\begin{code}
-showSplice :: String -> LHsExpr Id -> SDoc -> TcM ()
-showSplice what before after = do
- loc <- getSrcSpanM
- traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what,
- nest 2 (sep [nest 2 (ppr before),
- text "======>",
- nest 2 after])])
+showSplice :: String -> LHsExpr Name -> SDoc -> TcM ()
+-- Note that 'before' is *renamed* but not *typechecked*
+-- Reason (a) less typechecking crap
+-- (b) data constructors after type checking have been
+-- changed to their *wrappers*, and that makes them
+-- print always fully qualified
+showSplice what before after
+ = do { loc <- getSrcSpanM
+ ; traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what,
+ nest 2 (sep [nest 2 (ppr before),
+ text "======>",
+ nest 2 after])]) }
illegalBracket :: ThStage -> SDoc
illegalBracket level