ghc-lib-parser 0.20190516 → 0.20190523

raw patch · 16 files changed

+257/−210 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• compiler/basicTypes/UniqSupply.hs +41/−21
• compiler/ghci/LinkerTypes.hs +112/−0
• compiler/hsSyn/HsDecls.hs +40/−55
• compiler/hsSyn/HsExtension.hs +5/−5
• compiler/hsSyn/HsInstances.hs +4/−4
• compiler/main/DynFlags.hs +8/−1
• compiler/main/HscTypes.hs +9/−48
• compiler/parser/RdrHsSyn.hs +19/−59
• compiler/utils/FastString.hs +2/−2
• ghc-lib-parser.cabal +2/−1
• ghc-lib/generated/ghcversion.h +1/−1
• ghc-lib/stage0/compiler/build/Parser.hs +1/−1
• ghc-lib/stage1/compiler/build/Config.hs +4/−4
• includes/rts/storage/InfoTables.h +1/−1
• libraries/template-haskell/Language/Haskell/TH/PprLib.hs +3/−3
• libraries/template-haskell/Language/Haskell/TH/Syntax.hs +5/−4

@@ -3,8 +3,13 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} -{-# LANGUAGE CPP, UnboxedTuples #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE PatternSynonyms #-} +#if !defined(GHC_LOADED_INTO_GHCI)+{-# LANGUAGE UnboxedTuples #-}+#endif+ module UniqSupply (         -- * Main data type         UniqSupply, -- Abstractly@@ -131,22 +136,37 @@ ************************************************************************ -} +-- Avoids using unboxed tuples when loading into GHCi+#if !defined(GHC_LOADED_INTO_GHCI)++type UniqResult result = (# result, UniqSupply #)++pattern UniqResult :: a -> b -> (# a, b #)+pattern UniqResult x y = (# x, y #)+{-# COMPLETE UniqResult #-}++#else++data UniqResult result = UniqResult !result {-# UNPACK #-} !UniqSupply++#endif+ -- | A monad which just gives the ability to obtain 'Unique's-newtype UniqSM result = USM { unUSM :: UniqSupply -> (# result, UniqSupply #) }+newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result }  instance Monad UniqSM where   (>>=) = thenUs   (>>)  = (*>)  instance Functor UniqSM where-    fmap f (USM x) = USM (\us -> case x us of-                                 (# r, us' #) -> (# f r, us' #))+    fmap f (USM x) = USM (\us0 -> case x us0 of+                                 UniqResult r us1 -> UniqResult (f r) us1)  instance Applicative UniqSM where     pure = returnUs-    (USM f) <*> (USM x) = USM $ \us -> case f us of-                            (# ff, us' #)  -> case x us' of-                              (# xx, us'' #) -> (# ff xx, us'' #)+    (USM f) <*> (USM x) = USM $ \us0 -> case f us0 of+                            UniqResult ff us1 -> case x us1 of+                              UniqResult xx us2 -> UniqResult (ff xx) us2     (*>) = thenUs_  -- TODO: try to get rid of this instance@@ -155,11 +175,11 @@  -- | Run the 'UniqSM' action, returning the final 'UniqSupply' initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply)-initUs init_us m = case unUSM m init_us of { (# r, us #) -> (r,us) }+initUs init_us m = case unUSM m init_us of { UniqResult r us -> (r, us) }  -- | Run the 'UniqSM' action, discarding the final 'UniqSupply' initUs_ :: UniqSupply -> UniqSM a -> a-initUs_ init_us m = case unUSM m init_us of { (# r, _ #) -> r }+initUs_ init_us m = case unUSM m init_us of { UniqResult r _ -> r }  {-# INLINE thenUs #-} {-# INLINE lazyThenUs #-}@@ -169,29 +189,29 @@ -- @thenUs@ is where we split the @UniqSupply@.  liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)-liftUSM (USM m) us = case m us of (# a, us' #) -> (a, us')+liftUSM (USM m) us0 = case m us0 of UniqResult a us1 -> (a, us1)  instance MonadFix UniqSM where-    mfix m = USM (\us -> let (r,us') = liftUSM (m r) us in (# r,us' #))+    mfix m = USM (\us0 -> let (r,us1) = liftUSM (m r) us0 in UniqResult r us1)  thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b thenUs (USM expr) cont-  = USM (\us -> case (expr us) of-                   (# result, us' #) -> unUSM (cont result) us')+  = USM (\us0 -> case (expr us0) of+                   UniqResult result us1 -> unUSM (cont result) us1)  lazyThenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b lazyThenUs expr cont-  = USM (\us -> let (result, us') = liftUSM expr us in unUSM (cont result) us')+  = USM (\us0 -> let (result, us1) = liftUSM expr us0 in unUSM (cont result) us1)  thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b thenUs_ (USM expr) (USM cont)-  = USM (\us -> case (expr us) of { (# _, us' #) -> cont us' })+  = USM (\us0 -> case (expr us0) of { UniqResult _ us1 -> cont us1 })  returnUs :: a -> UniqSM a-returnUs result = USM (\us -> (# result, us #))+returnUs result = USM (\us -> UniqResult result us)  getUs :: UniqSM UniqSupply-getUs = USM (\us -> case splitUniqSupply us of (us1,us2) -> (# us1, us2 #))+getUs = USM (\us0 -> case splitUniqSupply us0 of (us1,us2) -> UniqResult us1 us2)  -- | A monad for generating unique identifiers class Monad m => MonadUnique m where@@ -221,12 +241,12 @@ liftUs m = getUniqueSupplyM >>= return . flip initUs_ m  getUniqueUs :: UniqSM Unique-getUniqueUs = USM (\us -> case takeUniqFromSupply us of-                          (u,us') -> (# u, us' #))+getUniqueUs = USM (\us0 -> case takeUniqFromSupply us0 of+                           (u,us1) -> UniqResult u us1)  getUniquesUs :: UniqSM [Unique]-getUniquesUs = USM (\us -> case splitUniqSupply us of-                           (us1,us2) -> (# uniqsFromSupply us1, us2 #))+getUniquesUs = USM (\us0 -> case splitUniqSupply us0 of+                            (us1,us2) -> UniqResult (uniqsFromSupply us1) us2)  -- {-# SPECIALIZE mapM          :: (a -> UniqSM b) -> [a] -> UniqSM [b] #-} -- {-# SPECIALIZE mapAndUnzipM  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c]) #-}

@@ -0,0 +1,112 @@+-----------------------------------------------------------------------------+--+-- Types for the Dynamic Linker+--+-- (c) The University of Glasgow 2019+--+-----------------------------------------------------------------------------++module LinkerTypes (+      DynLinker(..),+      PersistentLinkerState(..),+      LinkerUnitId,+      Linkable(..),+      Unlinked(..),+      SptEntry(..)+    ) where++import GhcPrelude              ( FilePath, String, show )+import Data.Time               ( UTCTime )+import Data.Maybe              ( Maybe )+import Control.Concurrent.MVar ( MVar )+import Module                  ( InstalledUnitId, Module )+import ByteCodeTypes           ( ItblEnv, CompiledByteCode )+import Outputable+import Var                     ( Id )+import GHC.Fingerprint.Type    ( Fingerprint )+import NameEnv                 ( NameEnv )+import Name                    ( Name )+import GHCi.RemoteTypes        ( ForeignHValue )++type ClosureEnv = NameEnv (Name, ForeignHValue) ++newtype DynLinker =+  DynLinker { dl_mpls :: MVar (Maybe PersistentLinkerState) }++data PersistentLinkerState+  = PersistentLinkerState {++       -- Current global mapping from Names to their true values+       closure_env :: ClosureEnv,++       -- The current global mapping from RdrNames of DataCons to+       -- info table addresses.+       -- When a new Unlinked is linked into the running image, or an existing+       -- module in the image is replaced, the itbl_env must be updated+       -- appropriately.+       itbl_env    :: !ItblEnv,++       -- The currently loaded interpreted modules (home package)+       bcos_loaded :: ![Linkable],++       -- And the currently-loaded compiled modules (home package)+       objs_loaded :: ![Linkable],++       -- The currently-loaded packages; always object code+       -- Held, as usual, in dependency order; though I am not sure if+       -- that is really important+       pkgs_loaded :: ![LinkerUnitId],++       -- we need to remember the name of previous temporary DLL/.so+       -- libraries so we can link them (see #10322)+       temp_sos :: ![(FilePath, String)] }++-- TODO: Make this type more precise+type LinkerUnitId = InstalledUnitId++-- | Information we can use to dynamically link modules into the compiler+data Linkable = LM {+  linkableTime     :: UTCTime,          -- ^ Time at which this linkable was built+                                        -- (i.e. when the bytecodes were produced,+                                        --       or the mod date on the files)+  linkableModule   :: Module,           -- ^ The linkable module itself+  linkableUnlinked :: [Unlinked]+    -- ^ Those files and chunks of code we have yet to link.+    --+    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.+    -- If this list is empty, the Linkable represents a fake linkable, which+    -- is generated in HscNothing mode to avoid recompiling modules.+    --+    -- ToDo: Do items get removed from this list when they get linked?+ }++instance Outputable Linkable where+  ppr (LM when_made mod unlinkeds)+     = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)+       $$ nest 3 (ppr unlinkeds)++-- | Objects which have yet to be linked by the compiler+data Unlinked+  = DotO FilePath      -- ^ An object file (.o)+  | DotA FilePath      -- ^ Static archive file (.a)+  | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)+  | BCOs CompiledByteCode+         [SptEntry]    -- ^ A byte-code object, lives only in memory. Also+                       -- carries some static pointer table entries which+                       -- should be loaded along with the BCOs.+                       -- See Note [Grant plan for static forms] in+                       -- StaticPtrTable.++instance Outputable Unlinked where+  ppr (DotO path)   = text "DotO" <+> text path+  ppr (DotA path)   = text "DotA" <+> text path+  ppr (DotDLL path) = text "DotDLL" <+> text path+  ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt++-- | An entry to be inserted into a module's static pointer table.+-- See Note [Grand plan for static forms] in StaticPtrTable.+data SptEntry = SptEntry Id Fingerprint++instance Outputable SptEntry where+  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr+

@@ -37,11 +37,11 @@   -- ** Instance declarations   InstDecl(..), LInstDecl, FamilyInfo(..),   TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,+  TyFamDefltDecl, LTyFamDefltDecl,   DataFamInstDecl(..), LDataFamInstDecl,-  pprDataFamInstFlavour, pprHsFamInstLHS,+  pprDataFamInstFlavour, pprTyFamInstDecl, pprHsFamInstLHS,   FamInstEqn, LFamInstEqn, FamEqn(..),-  TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,-  HsTyPats,+  TyFamInstEqn, LTyFamInstEqn, HsTyPats,   LClsInstDecl, ClsInstDecl(..),    -- ** Standalone deriving declarations@@ -533,7 +533,7 @@                 tcdSigs    :: [LSig pass],              -- ^ Methods' signatures                 tcdMeths   :: LHsBinds pass,            -- ^ Default methods                 tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;-                tcdATDefs  :: [LTyFamDefltEqn pass],    -- ^ Associated type defaults+                tcdATDefs  :: [LTyFamDefltDecl pass],   -- ^ Associated type defaults                 tcdDocs    :: [LDocDecl]                -- ^ Haddock docs     }         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',@@ -726,7 +726,7 @@       | otherwise       -- Laid out       = vcat [ top_matter <+> text "where"              , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++-                                     map ppr_fam_deflt_eqn at_defs +++                                     map (pprTyFamDefltDecl . unLoc) at_defs ++                                      pprLHsBindsForUser methods sigs) ]       where         top_matter = text "class"@@ -1507,28 +1507,23 @@ Note [Type family instance declarations in HsSyn] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The data type FamEqn represents one equation of a type family instance.-Aside from the pass, it is also parameterised over two fields:-feqn_pats and feqn_rhs.--feqn_pats is either LHsTypes (for ordinary data/type family instances) or-LHsQTyVars (for associated type family default instances). In particular:+Aside from the pass, it is also parameterised over another field, feqn_rhs.+feqn_rhs is either an HsDataDefn (for data family instances) or an LHsType+(for type family instances). - * An ordinary type family instance declaration looks like this in source Haskell-      type instance T [a] Int = a -> a-   (or something similar for a closed family)-   It is represented by a FamInstEqn, with a *type* (LHsType) in the feqn_pats-   field.+Type family instances also include associated type family default equations.+That is because a default for a type family looks like this: - * On the other hand, the *default instance* of an associated type looks like-   this in source Haskell-      class C a where-        type T a b-        type T a b = a -> b   -- The default instance-   It is represented by a TyFamDefltEqn, with *type variables* (LHsQTyVars) in-   the feqn_pats field.+  class C a where+    type family F a b :: Type+    type F c d = (c,d)   -- Default instance -feqn_rhs is either an HsDataDefn (for data family instances) or an LHsType-(for type family instances).+The default declaration is really just a `type instance` declaration, but one+with particularly simple patterns: they must all be distinct type variables.+That's because we will instantiate it (in an instance declaration for `C`) if+we don't give an explicit instance for `F`. Note that the names of the+variables don't need to match those of the class: it really is like a+free-standing `type instance` declaration. -}  ----------------- Type synonym family instances -------------@@ -1540,16 +1535,13 @@  -- For details on above see note [Api annotations] in ApiAnnotation --- | Located Type Family Default Equation-type LTyFamDefltEqn pass = Located (TyFamDefltEqn pass)- -- | Haskell Type Patterns type HsTyPats pass = [LHsTypeArg pass]  {- Note [Family instance declaration binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-For ordinary data/type family instances, the feqn_pats field of FamEqn stores-the LHS type (and kind) patterns. Any type (and kind) variables contained+The feqn_pats field of FamEqn (family instance equation) stores the LHS type+(and kind) patterns. Any type (and kind) variables contained in these type patterns are bound in the hsib_vars field of the HsImplicitBndrs in FamInstEqn depending on whether or not an explicit forall is present. In the case of an explicit forall, the hsib_vars only includes kind variables not@@ -1577,20 +1569,20 @@    so that we can compare the type pattern in the 'instance' decl and    in the associated 'type' decl -For associated type family default instances (TyFamDefltEqn), instead of using-type patterns with binders in a surrounding HsImplicitBndrs, we use raw type-variables (LHsQTyVars) in the feqn_pats field of FamEqn.--c.f. Note [TyVar binders for associated declarations]+c.f. Note [TyVar binders for associated decls] -}  -- | Type Family Instance Equation type TyFamInstEqn pass = FamInstEqn pass (LHsType pass) --- | Type Family Default Equation-type TyFamDefltEqn pass = FamEqn pass (LHsQTyVars pass) (LHsType pass)-  -- See Note [Type family instance declarations in HsSyn]+-- | Type family default declarations.+-- A convenient synonym for 'TyFamInstDecl'.+-- See @Note [Type family instance declarations in HsSyn]@.+type TyFamDefltDecl = TyFamInstDecl +-- | Located type family default declarations.+type LTyFamDefltDecl pass = Located (TyFamDefltDecl pass)+ -- | Located Type Family Instance Declaration type LTyFamInstDecl pass = Located (TyFamInstDecl pass) @@ -1625,8 +1617,7 @@ type LFamInstEqn pass rhs = Located (FamInstEqn pass rhs)  -- | Family Instance Equation-type FamInstEqn pass rhs-  = HsImplicitBndrs pass (FamEqn pass (HsTyPats pass) rhs)+type FamInstEqn pass rhs = HsImplicitBndrs pass (FamEqn pass rhs)             -- ^ Here, the @pats@ are type patterns (with kind and type bndrs).             -- See Note [Family instance declaration binders] @@ -1636,23 +1627,23 @@ -- declaration, or type family default. -- See Note [Type family instance declarations in HsSyn] -- See Note [Family instance declaration binders]-data FamEqn pass pats rhs+data FamEqn pass rhs   = FamEqn-       { feqn_ext    :: XCFamEqn pass pats rhs+       { feqn_ext    :: XCFamEqn pass rhs        , feqn_tycon  :: Located (IdP pass)        , feqn_bndrs  :: Maybe [LHsTyVarBndr pass] -- ^ Optional quantified type vars-       , feqn_pats   :: pats+       , feqn_pats   :: HsTyPats pass        , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration        , feqn_rhs    :: rhs        }     -- ^     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'-  | XFamEqn (XXFamEqn pass pats rhs)+  | XFamEqn (XXFamEqn pass rhs)      -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCFamEqn    (GhcPass _) p r = NoExt-type instance XXFamEqn    (GhcPass _) p r = NoExt+type instance XCFamEqn    (GhcPass _) r = NoExt+type instance XXFamEqn    (GhcPass _) r = NoExt  ----------------- Class instances ------------- @@ -1723,6 +1714,10 @@ ppr_instance_keyword TopLevel    = text "instance" ppr_instance_keyword NotTopLevel = empty +pprTyFamDefltDecl :: (OutputableBndrId (GhcPass p))+                  => TyFamDefltDecl (GhcPass p) -> SDoc+pprTyFamDefltDecl = pprTyFamInstDecl NotTopLevel+ ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))                  => TyFamInstEqn (GhcPass p) -> SDoc ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon  = L _ tycon@@ -1733,16 +1728,6 @@     = pprHsFamInstLHS tycon bndrs pats fixity noLHsContext <+> equals <+> ppr rhs ppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x--ppr_fam_deflt_eqn :: (OutputableBndrId (GhcPass p))-                  => LTyFamDefltEqn (GhcPass p) -> SDoc-ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon  = tycon-                               , feqn_pats   = tvs-                               , feqn_fixity = fixity-                               , feqn_rhs    = rhs }))-    = text "type" <+> pp_vanilla_decl_head tycon tvs fixity noLHsContext-                  <+> equals <+> ppr rhs-ppr_fam_deflt_eqn (L _ (XFamEqn x)) = ppr x  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (DataFamInstDecl p) where

@@ -355,12 +355,12 @@  -- ------------------------------------- -- FamEqn type families-type family XCFamEqn      x p r-type family XXFamEqn      x p r+type family XCFamEqn      x r+type family XXFamEqn      x r -type ForallXFamEqn (c :: * -> Constraint) (x :: *) (p :: *) (r :: *) =-       ( c (XCFamEqn       x p r)-       , c (XXFamEqn       x p r)+type ForallXFamEqn (c :: * -> Constraint) (x :: *) (r :: *) =+       ( c (XCFamEqn       x r)+       , c (XXFamEqn       x r)        )  -- -------------------------------------

@@ -164,10 +164,10 @@ deriving instance Data (DataFamInstDecl GhcRn) deriving instance Data (DataFamInstDecl GhcTc) --- deriving instance (DataIdLR p p,Data pats,Data rhs)=>Data (FamEqn p pats rhs)-deriving instance (Data pats,Data rhs) => Data (FamEqn GhcPs pats rhs)-deriving instance (Data pats,Data rhs) => Data (FamEqn GhcRn pats rhs)-deriving instance (Data pats,Data rhs) => Data (FamEqn GhcTc pats rhs)+-- deriving instance (DataIdLR p p,Data rhs)=>Data (FamEqn p rhs)+deriving instance Data rhs => Data (FamEqn GhcPs rhs)+deriving instance Data rhs => Data (FamEqn GhcRn rhs)+deriving instance Data rhs => Data (FamEqn GhcTc rhs)  -- deriving instance (DataIdLR p p) => Data (ClsInstDecl p) deriving instance Data (ClsInstDecl GhcPs)

@@ -1022,6 +1022,7 @@   --  For ghc -M   depMakefile           :: FilePath,   depIncludePkgDeps     :: Bool,+  depIncludeCppDeps     :: Bool,   depExcludeMods        :: [ModuleName],   depSuffixes           :: [String], @@ -2010,6 +2011,7 @@         -- ghc -M values         depMakefile       = "Makefile",         depIncludePkgDeps = False,+        depIncludeCppDeps = False,         depExcludeMods    = [],         depSuffixes       = [],         -- end of ghc -M values@@ -2684,6 +2686,9 @@ setDepMakefile :: FilePath -> DynFlags -> DynFlags setDepMakefile f d = d { depMakefile = f } +setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags+setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }+ setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags setDepIncludePkgDeps b d = d { depIncludePkgDeps = b } @@ -3100,6 +3105,8 @@         -------- ghc -M -----------------------------------------------------   , make_ord_flag defGhcFlag "dep-suffix"              (hasArg addDepSuffix)   , make_ord_flag defGhcFlag "dep-makefile"            (hasArg setDepMakefile)+  , make_ord_flag defGhcFlag "include-cpp-deps"+        (noArg (setDepIncludeCppDeps True))   , make_ord_flag defGhcFlag "include-pkg-deps"         (noArg (setDepIncludePkgDeps True))   , make_ord_flag defGhcFlag "exclude-module"          (hasArg addDepExcludeMod)@@ -5838,7 +5845,7 @@     llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised"     llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised" -#if STAGE < 2+#if 1 GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags) #else SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags

@@ -181,6 +181,7 @@ import Packages hiding  ( Version(..) ) import CmdLineParser import DynFlags+import LinkerTypes      ( DynLinker, Linkable(..), Unlinked(..), SptEntry(..) ) import DriverPhases     ( Phase, HscSource(..), hscSourceString                         , isHsBootOrSig, isHsigFile ) import qualified DriverPhases as Phase@@ -375,8 +376,10 @@  -- | HscEnv is like 'Session', except that some of the fields are immutable. -- An HscEnv is used to compile a single module from plain Haskell source--- code (after preprocessing) to either C, assembly or C--.  Things like--- the module graph don't change during a single compilation.+-- code (after preprocessing) to either C, assembly or C--. It's also used+-- to store the dynamic linker state to allow for multiple linkers in the+-- same address space.+-- Things like the module graph don't change during a single compilation. -- -- Historical note: \"hsc\" used to be the name of the compiler binary, -- when there was a separate driver and compiler.  To compile a single@@ -438,6 +441,10 @@         , hsc_iserv :: MVar (Maybe IServ)                 -- ^ interactive server process.  Created the first                 -- time it is needed.++        , hsc_dynLinker :: DynLinker+                -- ^ dynamic linker. +  }  -- Note [hsc_type_env_var hack]@@ -1388,13 +1395,6 @@ appendStubC NoStubs            c_code = ForeignStubs empty c_code appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code) --- | An entry to be inserted into a module's static pointer table.--- See Note [Grand plan for static forms] in StaticPtrTable.-data SptEntry = SptEntry Id Fingerprint--instance Outputable SptEntry where-  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr- {- ************************************************************************ *                                                                      *@@ -2992,22 +2992,6 @@ stuff is the *dynamic* linker, and isn't present in a stage-1 compiler -} --- | Information we can use to dynamically link modules into the compiler-data Linkable = LM {-  linkableTime     :: UTCTime,          -- ^ Time at which this linkable was built-                                        -- (i.e. when the bytecodes were produced,-                                        --       or the mod date on the files)-  linkableModule   :: Module,           -- ^ The linkable module itself-  linkableUnlinked :: [Unlinked]-    -- ^ Those files and chunks of code we have yet to link.-    ---    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.-    -- If this list is empty, the Linkable represents a fake linkable, which-    -- is generated in HscNothing mode to avoid recompiling modules.-    ---    -- ToDo: Do items get removed from this list when they get linked?- }- isObjectLinkable :: Linkable -> Bool isObjectLinkable l = not (null unlinked) && all isObject unlinked   where unlinked = linkableUnlinked l@@ -3019,30 +3003,7 @@ linkableObjs :: Linkable -> [FilePath] linkableObjs l = [ f | DotO f <- linkableUnlinked l ] -instance Outputable Linkable where-   ppr (LM when_made mod unlinkeds)-      = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)-        $$ nest 3 (ppr unlinkeds)- ----------------------------------------------- | Objects which have yet to be linked by the compiler-data Unlinked-   = DotO FilePath      -- ^ An object file (.o)-   | DotA FilePath      -- ^ Static archive file (.a)-   | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)-   | BCOs CompiledByteCode-          [SptEntry]    -- ^ A byte-code object, lives only in memory. Also-                        -- carries some static pointer table entries which-                        -- should be loaded along with the BCOs.-                        -- See Note [Grant plan for static forms] in-                        -- StaticPtrTable.--instance Outputable Unlinked where-   ppr (DotO path)   = text "DotO" <+> text path-   ppr (DotA path)   = text "DotA" <+> text path-   ppr (DotDLL path) = text "DotDLL" <+> text path-   ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt  -- | Is this an actual file on disk we can link in somehow? isObject :: Unlinked -> Bool

@@ -45,7 +45,6 @@         mkExtName,    -- RdrName -> CLabelString         mkGadtDecl,   -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName         mkConDeclH98,-        mkATDefault,          -- Bunch of functions in the parser monad for         -- checking and constructing values@@ -173,14 +172,12 @@             -> P (LTyClDecl GhcPs)  mkClassDecl loc (dL->L _ (mcxt, tycl_hdr)) fds where_cls-  = do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls+  = do { (binds, sigs, ats, at_defs, _, docs) <- cvBindsAndSigs where_cls        ; let cxt = fromMaybe (noLoc []) mcxt        ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan-       ; (tyvars,annst) <- checkTyVarsP (text "class") whereDots cls tparams+       ; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams        ; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan-       ; (at_defs, annsi) <- mapAndUnzipM (eitherToP . mkATDefault) at_insts-       ; sequence_ annsi        ; return (cL loc (ClassDecl { tcdCExt = noExt, tcdCtxt = cxt                                    , tcdLName = cls, tcdTyVars = tyvars                                    , tcdFixity = fixity@@ -190,34 +187,6 @@                                    , tcdATs = ats, tcdATDefs = at_defs                                    , tcdDocs  = docs })) } -mkATDefault :: LTyFamInstDecl GhcPs-            -> Either (SrcSpan, SDoc) (LTyFamDefltEqn GhcPs, P ())--- ^ Take a type-family instance declaration and turn it into--- a type-family default equation for a class declaration.--- We parse things as the former and use this function to convert to the latter------ We use the Either monad because this also called from "Convert".------ The @P ()@ we return corresponds represents an action which will add--- some necessary paren annotations to the parsing context. Naturally, this--- is not something that the "Convert" use cares about.-mkATDefault (dL->L loc (TyFamInstDecl { tfid_eqn = HsIB { hsib_body = e }}))-      | FamEqn { feqn_tycon = tc, feqn_bndrs = bndrs, feqn_pats = pats-               , feqn_fixity = fixity, feqn_rhs = rhs } <- e-      = do { (tvs, anns) <- checkTyVars (text "default") equalsDots tc pats-           ; let f = cL loc (FamEqn { feqn_ext    = noExt-                                    , feqn_tycon  = tc-                                    , feqn_bndrs  = ASSERT( isNothing bndrs )-                                                    Nothing-                                    , feqn_pats   = tvs-                                    , feqn_fixity = fixity-                                    , feqn_rhs    = rhs })-           ; pure (f, addAnnsAt loc anns) }-mkATDefault (dL->L _ (TyFamInstDecl (HsIB _ (XFamEqn _)))) = panic "mkATDefault"-mkATDefault (dL->L _ (TyFamInstDecl (XHsImplicitBndrs _))) = panic "mkATDefault"-mkATDefault _ = panic "mkATDefault: Impossible Match"-                                -- due to #15884- mkTyData :: SrcSpan          -> NewOrData          -> Maybe (Located CType)@@ -230,7 +199,7 @@          ksig data_cons maybe_deriv   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan-       ; (tyvars, anns) <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams+       ; (tyvars, anns) <- checkTyVars (ppr new_or_data) equalsDots tc tparams        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv        ; return (cL loc (DataDecl { tcdDExt = noExt,@@ -263,7 +232,7 @@ mkTySynonym loc lhs rhs   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan-       ; (tyvars, anns) <- checkTyVarsP (text "type") equalsDots tc tparams+       ; (tyvars, anns) <- checkTyVars (text "type") equalsDots tc tparams        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan        ; return (cL loc (SynDecl { tcdSExt = noExt                                  , tcdLName = tc, tcdTyVars = tyvars@@ -322,7 +291,7 @@ mkFamDecl loc info lhs ksig injAnn   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan-       ; (tyvars, anns) <- checkTyVarsP (ppr info) equals_or_where tc tparams+       ; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan        ; return (cL loc (FamDecl noExt (FamilyDecl                                            { fdExt       = noExt@@ -804,56 +773,47 @@ really doesn't matter! -} -checkTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]-             -> P (LHsQTyVars GhcPs, [AddAnn])--- Same as checkTyVars, but in the P monad-checkTyVarsP pp_what equals_or_where tc tparms-  = do { let checkedTvs = checkTyVars pp_what equals_or_where tc tparms-       ; eitherToP checkedTvs }- eitherToP :: Either (SrcSpan, SDoc) a -> P a -- Adapts the Either monad to the P monad eitherToP (Left (loc, doc)) = addFatalError loc doc eitherToP (Right thing)     = return thing  checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsTypeArg GhcPs]-            -> Either (SrcSpan, SDoc)-                      ( LHsQTyVars GhcPs  -- the synthesized type variables-                      , [AddAnn] )        -- action which adds annotations+            -> P ( LHsQTyVars GhcPs  -- the synthesized type variables+                 , [AddAnn] )        -- action which adds annotations -- ^ Check whether the given list of type parameters are all type variables -- (possibly with a kind signature).--- We use the Either monad because it's also called (via 'mkATDefault') from--- "Convert". checkTyVars pp_what equals_or_where tc tparms   = do { (tvs, anns) <- fmap unzip $ mapM check tparms        ; return (mkHsQTvs tvs, concat anns) }   where     check (HsTypeArg _ ki@(L loc _))-                              = Left (loc,+                              = addFatalError loc $                                       vcat [ text "Unexpected type application" <+>                                             text "@" <> ppr ki                                           , text "In the" <+> pp_what <+>-                                            ptext (sLit "declaration for") <+> quotes (ppr tc)])+                                            ptext (sLit "declaration for") <+> quotes (ppr tc)]     check (HsValArg ty) = chkParens [] ty-    check (HsArgPar sp) = Left (sp, vcat [text "Malformed" <+> pp_what-                           <+> text "declaration for" <+> quotes (ppr tc)])+    check (HsArgPar sp) = addFatalError sp $+                          vcat [text "Malformed" <+> pp_what+                            <+> text "declaration for" <+> quotes (ppr tc)]         -- Keep around an action for adjusting the annotations of extra parens     chkParens :: [AddAnn] -> LHsType GhcPs-              -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs, [AddAnn])+              -> P (LHsTyVarBndr GhcPs, [AddAnn])     chkParens acc (dL->L l (HsParTy _ ty)) = chkParens (mkParensApiAnn l                                                         ++ acc) ty-    chkParens acc ty = case chk ty of-      Left err -> Left err-      Right tv -> Right (tv, reverse acc)+    chkParens acc ty = do+      tv <- chk ty+      return (tv, reverse acc)          -- Check that the name space is correct!-    chk :: LHsType GhcPs -> Either (SrcSpan, SDoc) (LHsTyVarBndr GhcPs)+    chk :: LHsType GhcPs -> P (LHsTyVarBndr GhcPs)     chk (dL->L l (HsKindSig _ (dL->L lv (HsTyVar _ _ (dL->L _ tv))) k))         | isRdrTyVar tv    = return (cL l (KindedTyVar noExt (cL lv tv) k))     chk (dL->L l (HsTyVar _ _ (dL->L ltv tv)))         | isRdrTyVar tv    = return (cL l (UserTyVar noExt (cL ltv tv)))     chk t@(dL->L loc _)-        = Left (loc,+        = addFatalError loc $                 vcat [ text "Unexpected type" <+> quotes (ppr t)                      , text "In the" <+> pp_what                        <+> ptext (sLit "declaration for") <+> quotes tc'@@ -863,7 +823,7 @@                        (pp_what                         <+> tc'                         <+> hsep (map text (takeList tparms allNameStrings))-                        <+> equals_or_where) ] ])+                        <+> equals_or_where) ] ]      -- Avoid printing a constraint tuple in the error message. Print     -- a plain old tuple instead (since that's what the user probably

@@ -125,7 +125,7 @@  import Foreign -#if STAGE >= 2+#if 0 import GHC.Conc.Sync    (sharedCAF) #endif @@ -326,7 +326,7 @@    -- use the support wired into the RTS to share this CAF among all images of   -- libHSghc-#if STAGE < 2+#if 1   return tab #else   sharedCAF tab getOrSetLibHSghcFastStringTable

@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-parser-version: 0.20190516+version: 0.20190523 license: BSD3 license-file: LICENSE category: Development@@ -268,6 +268,7 @@         Language.Haskell.TH.Syntax         Lexeme         Lexer+        LinkerTypes         ListSetOps         Literal         Maybes

@@ -6,7 +6,7 @@ #endif  #define __GLASGOW_HASKELL_PATCHLEVEL1__ 0-#define __GLASGOW_HASKELL_PATCHLEVEL2__ 20190514+#define __GLASGOW_HASKELL_PATCHLEVEL2__ 20190522  #define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\    ((ma)*100+(mi)) <  __GLASGOW_HASKELL__ || \

@@ -12744,7 +12744,7 @@   {-# LINE 19 "<built-in>" #-}-{-# LINE 1 "/var/folders/f_/bb4zyb7d2_z9bqm3hrqrjgp40000gn/T/ghc72921_0/ghc_2.h" #-}+{-# LINE 1 "/var/folders/f_/bb4zyb7d2_z9bqm3hrqrjgp40000gn/T/ghc35710_0/ghc_2.h" #-}   

@@ -13,17 +13,17 @@ cProjectName          :: String cProjectName          = "The Glorious Glasgow Haskell Compilation System" cProjectGitCommitId   :: String-cProjectGitCommitId   = "a416ae26a2e45de3d9a76e94fc22aaa53e9e5b12"+cProjectGitCommitId   = "4ba73e00c4887b58d85131601a15d00608acaa60" cProjectVersion       :: String-cProjectVersion       = "8.9.0.20190514"+cProjectVersion       = "8.9.0.20190522" cProjectVersionInt    :: String cProjectVersionInt    = "809" cProjectPatchLevel    :: String-cProjectPatchLevel    = "020190514"+cProjectPatchLevel    = "020190522" cProjectPatchLevel1   :: String cProjectPatchLevel1   = "0" cProjectPatchLevel2   :: String-cProjectPatchLevel2   = "20190514"+cProjectPatchLevel2   = "20190522" cBooterVersion        :: String cBooterVersion        = "8.6.5" cStage                :: String

@@ -189,7 +189,7 @@     StgHalfWord     type;       /* closure type */     StgSRTField     srt;        /* In a CONSTR:-            - the constructor tag+            - the zero-based constructor tag           In a FUN/THUNK             - if USE_INLINE_SRT_FIELD               - offset to the SRT (or zero if no SRT)

@@ -36,14 +36,14 @@   import Language.Haskell.TH.Syntax-    (Name(..), showName', NameFlavour(..), NameIs(..))+    (Uniq, Name(..), showName', NameFlavour(..), NameIs(..)) import qualified Text.PrettyPrint as HPJ import Control.Monad (liftM, liftM2, ap) import Language.Haskell.TH.Lib.Map ( Map ) import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty ) import Prelude hiding ((<>)) -infixl 6 <> +infixl 6 <> infixl 6 <+> infixl 5 $$, $+$ @@ -117,7 +117,7 @@ -- --------------------------------------------------------------------------- -- The "implementation" -type State = (Map Name Name, Int)+type State = (Map Name Name, Uniq) data PprM a = PprM { runPprM :: State -> (a, State) }  pprName :: Name -> Doc

@@ -155,7 +155,7 @@                 ; fail "Template Haskell failure" }  -- Global variable to generate unique symbols-counter :: IORef Int+counter :: IORef Uniq {-# NOINLINE counter #-} counter = unsafePerformIO (newIORef 0) @@ -1299,8 +1299,8 @@ data NameFlavour   = NameS           -- ^ An unqualified name; dynamically bound   | NameQ ModName   -- ^ A qualified name; dynamically bound-  | NameU !Int      -- ^ A unique local name-  | NameL !Int      -- ^ Local name bound outside of the TH AST+  | NameU !Uniq     -- ^ A unique local name+  | NameL !Uniq     -- ^ Local name bound outside of the TH AST   | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:                 -- An original name (occurrences only, not binders)                 -- Need the namespace too to be sure which@@ -1313,7 +1313,8 @@                                 -- in the same name space for now.                deriving( Eq, Ord, Show, Data, Generic ) -type Uniq = Int+-- | @Uniq@ is used by GHC to distinguish names from each other.+type Uniq = Integer  -- | The name without its module prefix. --