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, 31 deletions

diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 30dd61bece..ff88dbffbc 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -210,7 +210,7 @@ matchNameMaker ctxt = LamMk report_unused
                       ThPatQuote            -> False
                       _                     -> True
 
-rnHsSigCps :: LHsSigWcType RdrName -> CpsRn (LHsSigWcType Name)
+rnHsSigCps :: LHsSigWcType GhcPs -> CpsRn (LHsSigWcType GhcRn)
 rnHsSigCps sig = CpsRn (rnHsSigWcTypeScoped PatCtx sig)
 
 newPatLName :: NameMaker -> Located RdrName -> CpsRn (Located Name)
@@ -302,8 +302,8 @@ There are various entry points to renaming patterns, depending on
 --   * unused and duplicate checking
 --   * no fixities
 rnPats :: HsMatchContext Name -- for error messages
-       -> [LPat RdrName]
-       -> ([LPat Name] -> RnM (a, FreeVars))
+       -> [LPat GhcPs]
+       -> ([LPat GhcRn] -> RnM (a, FreeVars))
        -> RnM (a, FreeVars)
 rnPats ctxt pats thing_inside
   = do  { envs_before <- getRdrEnvs
@@ -329,8 +329,8 @@ rnPats ctxt pats thing_inside
     doc_pat = text "In" <+> pprMatchContext ctxt
 
 rnPat :: HsMatchContext Name -- for error messages
-      -> LPat RdrName
-      -> (LPat Name -> RnM (a, FreeVars))
+      -> LPat GhcPs
+      -> (LPat GhcRn -> RnM (a, FreeVars))
       -> RnM (a, FreeVars)     -- Variables bound by pattern do not
                                -- appear in the result FreeVars
 rnPat ctxt pat thing_inside
@@ -348,8 +348,8 @@ applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newPatLName mk rdr)
 --   * no unused and duplicate checking
 --   * fixities might be coming in
 rnBindPat :: NameMaker
-          -> LPat RdrName
-          -> RnM (LPat Name, FreeVars)
+          -> LPat GhcPs
+          -> RnM (LPat GhcRn, FreeVars)
    -- Returned FreeVars are the free variables of the pattern,
    -- of course excluding variables bound by this pattern
 
@@ -366,17 +366,17 @@ rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
 -- ----------- Entry point 3: rnLPatAndThen -------------------
 -- General version: parametrized by how you make new names
 
-rnLPatsAndThen :: NameMaker -> [LPat RdrName] -> CpsRn [LPat Name]
+rnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn]
 rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
   -- Despite the map, the monad ensures that each pattern binds
   -- variables that may be mentioned in subsequent patterns in the list
 
 --------------------
 -- The workhorse
-rnLPatAndThen :: NameMaker -> LPat RdrName -> CpsRn (LPat Name)
+rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn)
 rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
 
-rnPatAndThen :: NameMaker -> Pat RdrName -> CpsRn (Pat Name)
+rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
 rnPatAndThen _  (WildPat _)   = return (WildPat placeHolderType)
 rnPatAndThen mk (ParPat pat)  = do { pat' <- rnLPatAndThen mk pat; return (ParPat pat') }
 rnPatAndThen mk (LazyPat pat) = do { pat' <- rnLPatAndThen mk pat; return (LazyPat pat') }
@@ -411,7 +411,7 @@ rnPatAndThen mk (LitPat lit)
          else normal_lit }
   | otherwise = normal_lit
   where
-    normal_lit = do { liftCps (rnLit lit); return (LitPat lit) }
+    normal_lit = do { liftCps (rnLit lit); return (LitPat (convertLit lit)) }
 
 rnPatAndThen _ (NPat (L l lit) mb_neg _eq _)
   = do { (lit', mb_neg') <- liftCpsFV $ rnOverLit lit
@@ -502,9 +502,9 @@ rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
 
 --------------------
 rnConPatAndThen :: NameMaker
-                -> Located RdrName          -- the constructor
-                -> HsConPatDetails RdrName
-                -> CpsRn (Pat Name)
+                -> Located RdrName    -- the constructor
+                -> HsConPatDetails GhcPs
+                -> CpsRn (Pat GhcRn)
 
 rnConPatAndThen mk con (PrefixCon pats)
   = do  { con' <- lookupConCps con
@@ -526,8 +526,8 @@ rnConPatAndThen mk con (RecCon rpats)
 --------------------
 rnHsRecPatsAndThen :: NameMaker
                    -> Located Name      -- Constructor
-                   -> HsRecFields RdrName (LPat RdrName)
-                   -> CpsRn (HsRecFields Name (LPat Name))
+                   -> HsRecFields GhcPs (LPat GhcPs)
+                   -> CpsRn (HsRecFields GhcRn (LPat GhcRn))
 rnHsRecPatsAndThen mk (L _ con) hs_rec_fields@(HsRecFields { rec_dotdot = dd })
   = do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) mkVarPat
                                             hs_rec_fields
@@ -562,8 +562,8 @@ rnHsRecFields
        HsRecFieldContext
     -> (SrcSpan -> RdrName -> arg)
          -- When punning, use this to build a new field
-    -> HsRecFields RdrName (Located arg)
-    -> RnM ([LHsRecField Name (Located arg)], FreeVars)
+    -> HsRecFields GhcPs (Located arg)
+    -> RnM ([LHsRecField GhcRn (Located arg)], FreeVars)
 
 -- This surprisingly complicated pass
 --   a) looks up the field name (possibly using disambiguation)
@@ -597,8 +597,8 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
             Nothing  -> text "constructor field name"
             Just con -> text "field of constructor" <+> quotes (ppr con)
 
-    rn_fld :: Bool -> Maybe Name -> LHsRecField RdrName (Located arg)
-           -> RnM (LHsRecField Name (Located arg))
+    rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (Located arg)
+           -> RnM (LHsRecField GhcRn (Located arg))
     rn_fld pun_ok parent (L l (HsRecField { hsRecFieldLbl
                                               = L loc (FieldOcc (L ll lbl) _)
                                           , hsRecFieldArg = arg
@@ -616,10 +616,10 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                                      , hsRecPun      = pun })) }
 
     rn_dotdot :: Maybe Int      -- See Note [DotDot fields] in HsPat
-              -> Maybe Name     -- The constructor (Nothing for an
+              -> Maybe Name -- The constructor (Nothing for an
                                 --    out of scope constructor)
-              -> [LHsRecField Name (Located arg)] -- Explicit fields
-              -> RnM [LHsRecField Name (Located arg)]   -- Filled in .. fields
+              -> [LHsRecField GhcRn (Located arg)] -- Explicit fields
+              -> RnM [LHsRecField GhcRn (Located arg)]   -- Filled in .. fields
     rn_dotdot Nothing _mb_con _flds     -- No ".." at all
       = return []
     rn_dotdot (Just {}) Nothing _flds   -- Constructor out of scope
@@ -668,7 +668,8 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
       = do { env <- getGlobalRdrEnv; return (find_tycon env con) }
       | otherwise = return Nothing
 
-    find_tycon :: GlobalRdrEnv -> Name {- DataCon -} -> Maybe Name {- TyCon -}
+    find_tycon :: GlobalRdrEnv -> Name {- DataCon -}
+               -> Maybe Name {- TyCon -}
     -- Return the parent *type constructor* of the data constructor
     -- (that is, the parent of the data constructor),
     -- or 'Nothing' if it is a pattern synonym or not in scope.
@@ -713,8 +714,8 @@ fail.  But there is no need for disambiguation anyway, so we just return Nothing
 -}
 
 rnHsRecUpdFields
-    :: [LHsRecUpdField RdrName]
-    -> RnM ([LHsRecUpdField Name], FreeVars)
+    :: [LHsRecUpdField GhcPs]
+    -> RnM ([LHsRecUpdField GhcRn], FreeVars)
 rnHsRecUpdFields flds
   = do { pun_ok        <- xoptM LangExt.RecordPuns
        ; overload_ok   <- xoptM LangExt.DuplicateRecordFields
@@ -729,7 +730,8 @@ rnHsRecUpdFields flds
   where
     doc = text "constructor field name"
 
-    rn_fld :: Bool -> Bool -> LHsRecUpdField RdrName -> RnM (LHsRecUpdField Name, FreeVars)
+    rn_fld :: Bool -> Bool -> LHsRecUpdField GhcPs
+           -> RnM (LHsRecUpdField GhcRn, FreeVars)
     rn_fld pun_ok overload_ok (L l (HsRecField { hsRecFieldLbl = L loc f
                                                , hsRecFieldArg = arg
                                                , hsRecPun      = pun }))
@@ -775,7 +777,7 @@ rnHsRecUpdFields flds
 
 
 
-getFieldIds :: [LHsRecField Name arg] -> [Name]
+getFieldIds :: [LHsRecField GhcRn arg] -> [Name]
 getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds
 
 getFieldLbls :: [LHsRecField id arg] -> [RdrName]
@@ -824,7 +826,7 @@ that the types and classes they involve
 are made available.
 -}
 
-rnLit :: HsLit -> RnM ()
+rnLit :: HsLit p -> RnM ()
 rnLit (HsChar _ c) = checkErr (inCharRange c) (bogusCharError c)
 rnLit _ = return ()
 
@@ -855,7 +857,7 @@ can apply it explicitly. In this case it stays negative zero.  Trac #13211
 -}
 
 rnOverLit :: HsOverLit t ->
-             RnM ((HsOverLit Name, Maybe (HsExpr Name)), FreeVars)
+             RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
 rnOverLit origLit
   = do  { opt_NumDecimals <- xoptM LangExt.NumDecimals
         ; let { lit@(OverLit {ol_val=val})
@@ -895,6 +897,6 @@ bogusCharError :: Char -> SDoc
 bogusCharError c
   = text "character literal out of range: '\\" <> char c  <> char '\''
 
-badViewPat :: Pat RdrName -> SDoc
+badViewPat :: Pat GhcPs -> SDoc
 badViewPat pat = vcat [text "Illegal view pattern: " <+> ppr pat,
                        text "Use ViewPatterns to enable view patterns"]