+ Splicing a type
+%* *
+%************************************************************************
+
+Very like splicing an expression, but we don't yet share code.
+
+\begin{code}
+kcSpliceType (HsSplice name hs_expr)
+ = addSrcSpan (getLoc hs_expr) $ do
+ { level <- getStage
+ ; case spliceOK level of {
+ Nothing -> failWithTc (illegalSplice level) ;
+ Just next_level -> do
+
+ { case level of {
+ Comp -> do { (t,k) <- kcTopSpliceType hs_expr
+ ; return (unLoc t, k) } ;
+ Brack _ ps_var lie_var -> do
+
+ { -- A splice inside brackets
+ ; meta_ty <- tcMetaTy typeQTyConName
+ ; expr' <- setStage (Splice next_level) $
+ setLIEVar lie_var $
+ tcCheckRho hs_expr meta_ty
+
+ -- Write the pending splice into the bucket
+ ; ps <- readMutVar ps_var
+ ; writeMutVar ps_var ((name,expr') : ps)
+
+ -- e.g. [| Int -> $(h 4) |]
+ -- Here (h 4) :: Q Type
+ -- but $(h 4) :: forall a.a i.e. any kind
+ ; kind <- newKindVar
+ ; returnM (panic "kcSpliceType", kind) -- The returned type is ignored
+ }}}}}
+
+kcTopSpliceType :: LHsExpr Name -> TcM (LHsType Name, TcKind)
+kcTopSpliceType expr
+ = do { meta_ty <- tcMetaTy typeQTyConName
+
+ -- Typecheck the expression
+ ; zonked_q_expr <- tcTopSpliceExpr expr meta_ty
+
+ -- Run the expression
+ ; traceTc (text "About to run" <+> ppr zonked_q_expr)
+ ; simple_ty <- runMetaT zonked_q_expr
+
+ ; let -- simple_ty :: TH.Type
+ hs_ty2 :: LHsType RdrName
+ hs_ty2 = convertToHsType simple_ty
+
+ ; traceTc (text "Got result" <+> ppr hs_ty2)
+
+ ; showSplice "type" zonked_q_expr (ppr hs_ty2)
+
+ -- Rename it, but bale out if there are errors
+ -- otherwise the type checker just gives more spurious errors
+ ; let doc = ptext SLIT("In the spliced type") <+> ppr hs_ty2
+ ; hs_ty3 <- checkNoErrs (rnLHsType doc hs_ty2)
+
+ ; kcHsType hs_ty3 }
+\end{code}
+
+%************************************************************************
+%* *