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

compiler/deSugar/DsMeta.hs

@@ -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 }

compiler/hsSyn/HsExpr.lhs

@@ -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
 

compiler/hsSyn/HsUtils.lhs

@@ -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
 

compiler/rename/RnSplice.lhs

@@ -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,28 +132,27 @@ 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')
       | is_typed   -- Run it later, in the type checker
       = do {  -- Ugh!  See Note [Splices] above
-              lcl_rdr <- getLocalRdrEnv
+             lcl_rdr <- getLocalRdrEnv
            ; gbl_rdr <- getGlobalRdrEnv
            ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
                                                      , isLocalGRE gre]
@@ -161,7 +162,7 @@ rnSpliceExpr is_typed splice
 
       | otherwise  -- Run it here
       = do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
-      
+
              -- The splice must have type ExpQ
            ; meta_exp_ty <- tcMetaTy expQTyConName
 
@@ -183,12 +184,12 @@ 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') 
+    run_type_splice (HsSplice _ expr')
        = do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
-              
+
             ; meta_exp_ty <- tcMetaTy typeQTyConName
 
               -- Typecheck the expression
@@ -210,12 +211,12 @@ 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')
-      
+
            ; meta_exp_ty <- tcMetaTy patQTyConName
 
              -- Typecheck the expression
@@ -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}

compiler/typecheck/TcExpr.lhs

@@ -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 () }
 

compiler/typecheck/TcHsSyn.lhs

@@ -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)

compiler/typecheck/TcRnTypes.lhs

@@ -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
 

compiler/typecheck/TcSplice.lhs

@@ -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") }