Udate hsSyn AST to use Trees that Growwip/new-tree-one-param-2

Summary:
See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow

This commit prepares the ground for a full extensible AST, by replacing the type
parameter for the hsSyn data types with a set of indices into type families,

    data GhcPs -- ^ Index for GHC parser output
    data GhcRn -- ^ Index for GHC renamer output
    data GhcTc -- ^ Index for GHC typechecker output

These are now used instead of `RdrName`, `Name` and `Id`/`TcId`/`Var`

Where the original name type is required in a polymorphic context, this is
accessible via the IdP type family, defined as

    type family IdP p
    type instance IdP GhcPs = RdrName
    type instance IdP GhcRn = Name
    type instance IdP GhcTc = Id

These types are declared in the new 'hsSyn/HsExtension.hs' module.

To gain a better understanding of the extension mechanism, it has been applied
to `HsLit` only, also replacing the `SourceText` fields in them with extension
types.

To preserve extension generality, a type class is introduced to capture the
`SourceText` interface, which must be honoured by all of the extension points
which originally had a `SourceText`.  The class is defined as

    class HasSourceText a where
      -- Provide setters to mimic existing constructors
      noSourceText  :: a
      sourceText    :: String -> a

      setSourceText :: SourceText -> a
      getSourceText :: a -> SourceText

And the constraint is captured in `SourceTextX`, which is a constraint type
listing all the extension points that make use of the class.

Updating Haddock submodule to match.

Test Plan: ./validate

Reviewers: simonpj, shayan-najd, goldfire, austin, bgamari

Subscribers: rwbarton, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D3609

1 files changed, 33 insertions, 30 deletions

diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index e0f9493291..a03e4c88df 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module RnSplice (
         rnTopSpliceDecls,
@@ -40,7 +41,6 @@ import FastString
 import ErrUtils         ( dumpIfSet_dyn_printer )
 import TcEnv            ( tcMetaTy )
 import Hooks
-import Var              ( Id )
 import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
                         , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
 
@@ -67,7 +67,7 @@ import qualified GHC.LanguageExtensions as LangExt
 ************************************************************************
 -}
 
-rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
+rnBracket :: HsExpr GhcPs -> HsBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
 rnBracket e br_body
   = addErrCtxt (quotationCtxtDoc br_body) $
     do { -- Check that -XTemplateHaskellQuotes is enabled and available
@@ -112,7 +112,7 @@ rnBracket e br_body
                         ; return (HsRnBracketOut body' pendings, fvs_e) }
        }
 
-rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
+rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
 rn_bracket outer_stage br@(VarBr flg rdr_name)
   = do { name <- lookupOccRn rdr_name
        ; this_mod <- getModule
@@ -159,7 +159,7 @@ rn_bracket _ (DecBrL decls)
                    ppr (duUses (tcg_dus tcg_env)))
         ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
   where
-    groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
+    groupDecls :: [LHsDecl GhcPs] -> RnM (HsGroup GhcPs)
     groupDecls decls
       = do { (group, mb_splice) <- findSplice decls
            ; case mb_splice of
@@ -176,7 +176,7 @@ rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
 rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
                              ; return (TExpBr e', fvs) }
 
-quotationCtxtDoc :: HsBracket RdrName -> SDoc
+quotationCtxtDoc :: HsBracket GhcPs -> SDoc
 quotationCtxtDoc br_body
   = hang (text "In the Template Haskell quotation")
          2 (ppr br_body)
@@ -194,7 +194,7 @@ illegalUntypedBracket :: SDoc
 illegalUntypedBracket =
     text "Untyped brackets may only appear in untyped splices."
 
-quotedNameStageErr :: HsBracket RdrName -> SDoc
+quotedNameStageErr :: HsBracket GhcPs -> SDoc
 quotedNameStageErr br
   = sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
         , text "must be used at the same stage at which it is bound" ]
@@ -236,9 +236,11 @@ returns a bogus term/type, so that it can report more than one error.
 We don't want the type checker to see these bogus unbound variables.
 -}
 
-rnSpliceGen :: (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
-            -> (HsSplice Name -> (PendingRnSplice, a))  -- Inside brackets, make it pending
-            -> HsSplice RdrName
+rnSpliceGen :: (HsSplice GhcRn -> RnM (a, FreeVars))
+                                            -- Outside brackets, run splice
+            -> (HsSplice GhcRn -> (PendingRnSplice, a))
+                                            -- Inside brackets, make it pending
+            -> HsSplice GhcPs
             -> RnM (a, FreeVars)
 rnSpliceGen run_splice pend_splice splice
   = addErrCtxt (spliceCtxt splice) $ do
@@ -281,10 +283,10 @@ rnSpliceGen run_splice pend_splice splice
 --
 -- See Note [Delaying modFinalizers in untyped splices].
 runRnSplice :: UntypedSpliceFlavour
-            -> (LHsExpr Id -> TcRn res)
+            -> (LHsExpr GhcTc -> TcRn res)
             -> (res -> SDoc)    -- How to pretty-print res
                                 -- Usually just ppr, but not for [Decl]
-            -> HsSplice Name    -- Always untyped
+            -> HsSplice GhcRn   -- Always untyped
             -> TcRn (res, [ForeignRef (TH.Q ())])
 runRnSplice flavour run_meta ppr_res splice
   = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)
@@ -329,7 +331,7 @@ runRnSplice flavour run_meta ppr_res splice
 
 ------------------
 makePending :: UntypedSpliceFlavour
-            -> HsSplice Name
+            -> HsSplice GhcRn
             -> PendingRnSplice
 makePending flavour (HsUntypedSplice _ n e)
   = PendingRnSplice flavour n e
@@ -341,7 +343,8 @@ makePending _ splice@(HsSpliced {})
   = pprPanic "makePending" (ppr splice)
 
 ------------------
-mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHsExpr Name
+mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
+                 -> LHsExpr GhcRn
 -- Return the expression (quoter "...quote...")
 -- which is what we must run in a quasi-quote
 mkQuasiQuoteExpr flavour quoter q_span quote
@@ -359,7 +362,7 @@ mkQuasiQuoteExpr flavour quoter q_span quote
                        UntypedDeclSplice -> quoteDecName
 
 ---------------------
-rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
+rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars)
 -- Not exported...used for all
 rnSplice (HsTypedSplice hasParen splice_name expr)
   = do  { checkTH expr "Template Haskell typed splice"
@@ -391,15 +394,15 @@ rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
 rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
 
 ---------------------
-rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
+rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
 rnSpliceExpr splice
   = rnSpliceGen run_expr_splice pend_expr_splice splice
   where
-    pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
+    pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn)
     pend_expr_splice rn_splice
         = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice)
 
-    run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
+    run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars)
     run_expr_splice rn_splice
       | isTypedSplice rn_splice   -- Run it later, in the type checker
       = do {  -- Ugh!  See Note [Splices] above
@@ -516,8 +519,8 @@ References:
 -}
 
 ----------------------
-rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
-             -> RnM (HsType Name, FreeVars)
+rnSpliceType :: HsSplice GhcPs -> PostTc GhcRn Kind
+             -> RnM (HsType GhcRn, FreeVars)
 rnSpliceType splice k
   = rnSpliceGen run_type_splice pend_type_splice splice
   where
@@ -583,7 +586,7 @@ whole signature, instead of as an arbitrary type.
 
 ----------------------
 -- | Rename a splice pattern. See Note [rnSplicePat]
-rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
+rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn)
                                        , FreeVars)
 rnSplicePat splice
   = rnSpliceGen run_pat_splice pend_pat_splice splice
@@ -606,7 +609,7 @@ rnSplicePat splice
               -- lose the outermost location set by runQuasiQuote (#7918)
 
 ----------------------
-rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
+rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
 rnSpliceDecl (SpliceDecl (L loc splice) flg)
   = rnSpliceGen run_decl_splice pend_decl_splice splice
   where
@@ -615,7 +618,7 @@ rnSpliceDecl (SpliceDecl (L loc splice) flg)
 
     run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
 
-rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
+rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
 -- Declaration splice at the very top level of the module
 rnTopSpliceDecls splice
    = do  { (rn_splice, fvs) <- checkNoErrs $
@@ -629,7 +632,7 @@ rnTopSpliceDecls splice
          ; add_mod_finalizers_now mod_finalizers
          ; return (decls,fvs) }
    where
-     ppr_decls :: [LHsDecl RdrName] -> SDoc
+     ppr_decls :: [LHsDecl GhcPs] -> SDoc
      ppr_decls ds = vcat (map ppr ds)
 
      -- Adds finalizers to the global environment instead of delaying them
@@ -673,7 +676,7 @@ Pat RdrName (the result of running a top-level splice) or a Pat Name
 rnSplicePat.
 -}
 
-spliceCtxt :: HsSplice RdrName -> SDoc
+spliceCtxt :: HsSplice GhcPs -> SDoc
 spliceCtxt splice
   = hang (text "In the" <+> what) 2 (ppr splice)
   where
@@ -686,12 +689,12 @@ spliceCtxt splice
 -- | The splice data to be logged
 data SpliceInfo
   = SpliceInfo
-    { spliceDescription   :: String
-    , spliceSource        :: Maybe (LHsExpr Name)  -- Nothing <=> top-level decls
-                                                   --        added by addTopDecls
-    , spliceIsDecl        :: Bool    -- True <=> put the generate code in a file
-                                     --          when -dth-dec-file is on
-    , spliceGenerated     :: SDoc
+    { spliceDescription  :: String
+    , spliceSource       :: Maybe (LHsExpr GhcRn) -- Nothing <=> top-level decls
+                                                  --        added by addTopDecls
+    , spliceIsDecl       :: Bool    -- True <=> put the generate code in a file
+                                    --          when -dth-dec-file is on
+    , spliceGenerated    :: SDoc
     }
         -- Note that 'spliceSource' is *renamed* but not *typechecked*
         -- Reason (a) less typechecking crap